;[I4-TENEX]X1CMD.MAC;20270, 28-DEC-79 10:24:17, Ed: RLWSSD ; BUG FIX IN ACCESS COMMAND ;[I4-TENEX]X1CMD.MAC;20269, 4-DEC-79 17:12:18, Ed: RLWSSD ; FIXED UP NEW MAIL MSGS AT LOGOUT. ;[I4-TENEX]X1CMD.MAC;20268, 4-DEC-79 10:55:36, Ed: RLWSSD ; CHANGED "PAGE-TABLE" ARG TO ACCESS COMMAND TO BE "LIST". ;X1CMD.MAC;20267 7-AUG-79 14:16:38 EDIT BY RLWSSD ; ADDED FCONTINUE COMMAND; SAME AS FOREGROUND FOLLOWED BY CONTINUE ;X1CMD.MAC;20266 3-AUG-79 14:58:05 EDIT BY RLWSSD ; MOVED UNTRAPPING & TIW STUFF BACK TO $WAIT 'CAUSE IT COULDN'T BE MADE ; TO WORK IN .FOREGROUND. FOO. ;X1CMD.MAC;20265 2-AUG-79 10:54:07 EDIT BY RLWSSD ; MOVED UNTRAPPING & RESTORATION OF TIW OF BACKGROUND FORKS FROM ; $WAIT TO .FOREGROUND ;X1CMD.MAC;20264 19-JUL-79 23:45:52 EDIT BY WEISSMAN ; MORE JSYS TRAPPING STUFF FOR BACKGROUND FORKS: TERM INTERRUPT HANDLING ;X1CMD.MAC;20263 18-JUL-79 14:44:45 EDIT BY WEISSMAN ; CHANGED MAIL WATCH TO BE FOR ANY USER ;X1CMD.MAC;20262 17-JUL-79 19:54:22 EDIT BY WEISSMAN ;X1CMD.MAC;20261 17-JUL-79 19:29:02 EDIT BY WEISSMAN ;X1CMD.MAC;20260 16-JUL-79 20:15:30 EDIT BY WEISSMAN ;X1CMD.MAC;20259 13-JUL-79 14:15:23 EDIT BY WEISSMAN ;X1CMD.MAC;20258 13-JUL-79 13:55:40 EDIT BY WEISSMAN ;X1CMD.MAC;20257 13-JUL-79 10:46:31 EDIT BY WEISSMAN ;X1CMD.MAC;20256 12-JUL-79 19:09:15 EDIT BY WEISSMAN ;X1CMD.MAC;20255 12-JUL-79 18:12:40 EDIT BY WEISSMAN ; ADDED PRINTER WATCH ROUTINE (PRIWAT) ;X1CMD.MAC;20254 12-JUL-79 17:45:24 EDIT BY WEISSMAN ;X1CMD.MAC;20253 12-JUL-79 17:21:42 EDIT BY WEISSMAN ;X1CMD.MAC;20252 12-JUL-79 16:59:54 EDIT BY WEISSMAN ;X1CMD.MAC;20251 12-JUL-79 16:38:32 EDIT BY WEISSMAN ;X1CMD.MAC;20250 12-JUL-79 16:03:02 EDIT BY WEISSMAN ;X1CMD.MAC;20249 12-JUL-79 15:30:41 EDIT BY WEISSMAN ;X1CMD.MAC;20248 12-JUL-79 14:54:31 EDIT BY WEISSMAN ;X1CMD.MAC;20247 11-JUL-79 20:49:36 EDIT BY WEISSMAN ;X1CMD.MAC;20246 11-JUL-79 20:30:16 EDIT BY WEISSMAN ;X1CMD.MAC;20245 11-JUL-79 20:07:16 EDIT BY WEISSMAN ;X1CMD.MAC;20243 11-JUL-79 19:40:44 EDIT BY WEISSMAN ;X1CMD.MAC;20242 11-JUL-79 19:17:15 EDIT BY WEISSMAN ;X1CMD.MAC;20241 11-JUL-79 18:59:54 EDIT BY WEISSMAN ; ADDED MAP COMMAND (.MAP ROUTN) ;X1CMD.MAC;20240 5-JUL-79 12:07:42 EDIT BY WEISSMAN ; ADDED CHECK FOR ANONYMOUS USER IN .LOGIN ;X1CMD.MAC;20239 3-JUL-79 17:45:41 EDIT BY WEISSMAN ;X1CMD.MAC;20238 3-JUL-79 17:37:55 EDIT BY WEISSMAN ;X1CMD.MAC;20237 3-JUL-79 17:23:24 EDIT BY WEISSMAN ;X1CMD.MAC;20236 3-JUL-79 17:13:46 EDIT BY WEISSMAN ; ADDED SET TABSTOPS (EVERY) N (SPACES) COMMAND ;X1CMD.MAC;20235 3-JUL-79 14:43:09 EDIT BY WEISSMAN ; FIXED BUG IN STOPS COMMAND (.STOPS ROUTINE) ;X1CMD.MAC;20234 29-JUN-79 16:10:35 EDIT BY WEISSMAN ;X1CMD.MAC;20233 29-JUN-79 16:03:33 EDIT BY WEISSMAN ;X1CMD.MAC;20232 29-JUN-79 15:54:39 EDIT BY WEISSMAN ;X1CMD.MAC;20231 28-JUN-79 15:31:53 EDIT BY WEISSMAN ; ADDED SPELLING CORRECTION (FEATUR %CORECT) AND JSYS TRAPPING ; (FEATUR %BAKTRP) LOGIC ; CHANGES FOR IAC OPERATION ;X1CMD.MAC;20202 24-OCT-78 09:09:33 EDIT BY B-SMITH ;Changed archive-lookup to always be from ;X1CMD.MAC;20201 18-OCT-78 09:51:30 EDIT BY B-SMITH ;Fixup MOVE for MFEXEC table macros ;Make RLPJFN a little cleaner ;Fix typo in LINK1 feature ;X1CMD.MAC;20200 27-SEP-78 09:43:17 EDIT BY B-SMITH ;Added BBN move command ;Removed restriction that fork names must not start with an octal digit. ; The name will always take precidence. ;Add new search path code ;Cleaned CONNECT, add From where feature. ;Bug fix in ASSIGN error reporting ;X1CMD.MAC;20104 2-FEB-78 17:02:53 EDIT BY DALE ; Bug fix PERPETUAL/PERMANENT ;X1CMD.MAC;20103 6-JAN-78 09:32:57 EDIT BY B-SMITH ;Bug fix to ephemeral dispatch ;Bug fix to BACKGROUND and GETFH ;Made CONTINUE more tolerant ;X1CMD.MAC;20102 2-JAN-78 16:50:20 EDIT BY DALE ;X1CMD.MAC;20101 29-DEC-77 08:42:04 EDIT BY B-SMITH ;2.01 ;X1CMD.MAC;20000 11-JAN-77 19:23:34 EDIT BY B-SMITH ;2.00 ; PDP-10 TENEX EXECUTIVE COMMANDS ROUTINES PRINTX Entering X1CMD ;ROUTINES TO DECODE AND EXECUTE SPECIFIC COMMANDS. ;DISPATCHED TO BY EXEC COMMAND INTERPRETER MAIN FILE (XMAIN.MAC). ;IN ALPHABETICAL ORDER BY COMMAND NAME. ;ACCESS (TO FILES) (BY) SELF,GROUP,OTHERS (IS) READ,WRITE, ; EXECUTE,APPEND,PAGE-TABLE,UNUSED,ALL,NONE .ACCES: NOISE CALL .INFG ;INPUT FILES LIST ALLOW TSPC!TALT!TLPR NOISE PUSH P,[0] ;TEMP ACCES1: TLO Z,NEOLF ;SAY DON'T ECHO EOLS KEYWD $ACCS1 T OTHERS,,COMOK!NSPALT,000077 ;DEFAULT JRST CERR ANDI KWV,-1 ;FLUSH FLAGS IORM KWV,0(P) ;VALUE IS MASK ALLOW TCOM!TALT!TSPC TRNE CBT,TCOM ;SEPARATOR WAS COMMA? JRST ACCES1 ;COMMA, GET NEXT WORD ACCES2: ALTYPE ( ) NOISE PUSH P,[0] ;TEMP ACCE21: TLO Z,NEOLF KEYWD $ACCS2 T NORMAL,,COMOK!EOLOK,52 JRST CERR ANDI KWV,-1 ;FLUSH FLAGS CAIE KWV,0 ;"NONE" CAIN KWV,52 ;"NORMAL" SETZM 0(P) ;CLEAR WHAT WAS SAID BEFORE IORM KWV,0(P) ;ACCUMULATE CALL SPRTR ;ANALYSE FIELD, TERMINATOR JRST ACCE21 ;ANOTHER FIELD, PROCESS IT JRST ACCE21 ;COMMA, PROCESS NEXT FIELD CONFIRM ;EOL, GO ACCES3: POP P,E IMULI E,010101 POP P,F ;MASK CALL FRSTF ;TYPE FIRST FILE NAME ACCES4: HRRZ 1,@INIFH1 ;GET JFN DVCHR TLNN 2,(1B4) ;DISK? JRST [ ETYPE < %1H: Does not have protected files > JRST NEXTF] ;GET NEXT FILE, GO TO ACCES4 MOVSI 1,FDBPRT ;PROTECTION WORD HRR 1,@INIFH1 ;FORM INDEX,,JFN HRRZ 2,F ;ACCESS PATHS HRRZ 3,E ;PROTECTION TRNE 2,20000 ;TRYING TO CHANGE THIS BIT TO 0? TROE 3,20000 CAIA TYPE < 20000-bit forced on > HRLI 3,(5B2) ;MAKE IT NUMERIC CHFDB ERJMP [ERROR (Access violation)] JRST NEXTF ;GET NEXT FILE, RETURN TO ACCES4 $ACCS1: TABLE T ALL,,COMOK,777777 T GROUP,,COMOK,007700 T OTHERS,,COMOK,000077 T SELF,,COMOK,770000 TEND $ACCS2: TABLE T ALL,,COMOK!EOLOK,77 T APPEND,,COMOK!EOLOK,04 T EXECUTE,,COMOK!EOLOK,10 IAC < T LIST,,COMOK!EOLOK,02 > T NONE,,COMOK!EOLOK,00 T NORMAL,,COMOK!EOLOK,52 NOIAC < T PAGE-TABLE,,COMOK!EOLOK,02 > IAC < T PAGE-TABLE,,COMOK!EOLOK!INVIS,02 > T READ,,COMOK!EOLOK,40 T UNUSED,,COMOK!EOLOK!INVIS,01 T WRITE,,COMOK!EOLOK,20 TEND ;ACCOUNT (OF FILE) (IS) .ACCOU: NOISE CALL .INFG ;INPUT FILE GROUP REPEAT 0,< ;SEE IF TARGET DIRECTORY SPECIFIES STRING OR NUMBER ACCOU0: MOVE A,CSBUFP MOVE B,CJFN1 HRLZI C,B5 ;DIRECTORY NAME ONLY, UNPUNCTUATED. JFNS ;GET STRING FOR DIRECTORY NAME > REPEAT 1,< ;SEE IF USER SPECIFIES STRING OR NUMERIC ACCT ACCOU1: MOVE B,CUSRNO ;USER'S LOGIN DIRECTORY MOVE A,CSBUFP DIRST CALL SCREWUP> ACCOU2: MOVEI A,1 MOVE B,CSBUFP STDIR ;CONVERT BACK TO GET LEFT HALF BITS JRST CERR JRST CERR ALLOW TSPC!TALT!TLPR!TEOL NOISE CALL ACCT ;GET ACCOUNT NUMBER OR STRING, USING A. MOVE E,A ;SAVE THRU DVCHR'S CONFIRM CALL FRSTF ;PRINT NAME OF FIRST FILE IN GROUP ACCOU3: HRRZ 1,@INIFH1 ;GET THE JFN DVCHR HLRZS 1 CAIE 1,600000 ;DEVICE IS DSK: ? JRST [ UTYPE [ASCIZ / Not a disk file/] JRST NEXTF] ;DO NEXT, RETURN TO ACCOU3 HRRZ 1,@INIFH1 ;JFN MOVE 2,E ;ACCOUNT SACTF ;SET ACCOUNT OF FILE CALL [ CAIN 1,SACTX4 UERR [ASCIZ /No access to change account of that file/] JRST JERR] JRST NEXTF ;GNJFN, TYPE NAME, GO TO ACCOU3 ;ADVISE (USER) .ADVIS: NOISE (user) CALL TTYNUM MOVEI 1,400000(1) ;FORM TTY DESIGNATOR TLO 1,(1B1) ;SET "ADVISE TO" FLAG ADVIZ CALL [ CAIN 1,ADVX4 ERROR CAIN 1,ADVX2 ERROR CAIN 1,ADVX1 ERROR JRST JERR] RET ;ALERT (AT TIME) FEATUR %ALERT,< .ALERT: SKIPLE A,ALRTIM ERROR NOISE (at time) CALL SHTIME JUMPLE A,CERR ;BAD DAYTIME (OR TOO FAR IN FUTURE) MOVEI B,^D30(A) IDIVI B,^D60 ;Truncate seconds off to minutes MULI B,^D60 ; and restore back HRR A,B PUSH P,A GTAD CAML A,0(P) ERROR ALERT1: CONFIRM ;LET WAKEUP MERGE IN, TIME PUSHED ;THERE SHOULD BE A STRING INPUT (MESSAGE) TO ASSOCIATE WITH ; THE ALERT POP P,ALRTIM RET ;WAKEUP (IN) .WAKEUP: SKIPLE A,ALRTIM ERROR NOISE (in) INHELP ALLOW TALT+TEOL+TSPC TLO Z,BAKFF CALL DECIN JRST CERR JUMPL A,CERR MOVE B,A GTAD CALL TIMPMN PUSH P,A JRST ALERT1 > ;"APPEND" IS WITH "COPY" IN X2CMD.MAC. ;ASSIGN .ASSIG: NOISE (device) CALL DEVN ;READ DEVICE NAME, CHECK IT. ;ACCEPTS USUAL TERMINATORS, PLUS COLON PUSH P,A ;...RETURNS DEV DESGNATOR IN A, PUSH P,B ;...CHARACTERISTICS IN B, ;...JOB # ASS TO IN C. TLNN B,B3 ERROR <%1H: Cannot be assigned> TLNN B,B5 ;"AVAILABLE" BIT JRST [ TLNN B,B6 ;NOT AVAIL, ASSIGNED? UERR [ASCIZ /%1H: Not available/] ;%H: DEV NAME UERR [ASCIZ /%1H: Already assigned to job %3Q/]] TLNE B,B6 $TYPE < [Already assigned to you] >; ADVISORY MSG, NOT ERROR LDB C,[POINT 9,A,17] CAIE C,12 ;DEVICE TYPE TTY? JRST ASSIG3 ;NO MOVEI E,(A) ;MASK TTY # GJINF ;JOB'S CONT TTY # TO D, JOB # TO C CAMN D,E ERROR MOVE A,['TTYJOB'] CALL $SYSGT ;GET # OF TABLE OF TTYS HRR A,B ;TABLE # HRL A,E ;TTY # IS TABLE INDEX GETAB ;GET TABLE WORD CALL JERR HLRZ B,A CAME B,C ;Assigned to me already CAIN B,-1 ; or free is ok JRST ASSIG3 MOVE A,-1(P) ;DEV DESIG FOR ERROR MESSAGES SKIPG C,B ERROR <%1H: Busy>; ;-2: BEING ASSIGNED ;B0+JOB # ASSIGNED TO ALSO GETS THIS ;IF FOR SOME REASON ABOVE CHECKS FAIL. MOVE A,['JOBTTY'] CALL $SYSGT HRR A,B ;Table number HRL A,C ;Job that owns specified tty. GETAB CALL JERR HLRZ D,A ;Get job's controlling tty MOVE A,-1(P) ;Device designator CAME D,E ;Specified and controlling same? ERROR <%1H: Is assigned to job %3Q> ERROR <%1H: Is the controlling terminal for job %3Q> ASSIG3: CONFIRM POP P,A ;DEVICE CHARACTERISTICS TLNN A,B7 ;"MOUNTABLE" BIT JRST ASSIG5 ;NOT MOUNTABLE MOVE A,(P) ;DEVICE DESIGNATOR ;TLO A,B3 ;SAY DON'T READ DIRECTORY MOUNT ;MIGHT BE NEEDED TO INVALIDATE DIR IN CORE CALL JERR ASSIG5: POP P,A ;DEVICE DESIGNATOR ASND CALL JERR RET ;ATTACH (USER) (PASSWORD) -- (TSS JOB #) <#> ;LIKE LOGIN, THIS COMMAND ALSO ACCEPTS THE FORM: ;ATTACH ;(USER) ;(PASSWORD) ---- ;(TSS JOB #) <#> ;PASSWORD IS NOT ECHOED IN FULL DUPLEX, TYPED OVER MASK ON ;FOLLOWING LINE IN HALF DUPLEX. ;TSS JOB # CAN BE OMITTED IF THERE IS ONLY ONE JOB FOR GIVEN USER. ;IF NOT LOGGED IN, CURRENT JOB GOES AWAY (HANDLED BY MONITOR), ;IF LOGGED IN IT IS DETACHED. .ATTAC: CALL SPECEOL ;SPECIAL HANDLING OF EOL TERMINATOR FOR ;OPTIONAL FANCY FORMAT. NOISE GJINF ;DEFAULT IS HIMSELF CALL USER ;INPUT USER (DIRECTORY) NAME TLNE A,B0 ERROR ALTYPE ( ) MOVEI A,(A) ;MASK DIR # PUSH P,A ;SAVE DIR # CALL SPECEOL ;CHECK TERMINATOR & HANDLE EOL SPECIALLY HRRZ A,0(P) ;DIRNUM CALL PASWD ;INPUT AND CHECK PASSWORD (USES A) PUSH P,A ;SAVE PASSWORD STRING POINTER NOISE INHELP < Number if you have more than one job> ALLOW TALT+TSPC+TEOL CAIN CNT,2 JRST [ MOVE B,.BFP ILDB B,B CAIN B,"-" JRST ATTAC5 ;NULL INDICATED WITH "-" JRST .+1] TLO Z,BAKFF CALL DECIN JRST [ UALTYP [ASCIZ /-/] ;NULL. TYPE "-" ON ALT MODE. JRST ATTAC5] PUSH P,A ;SAVE JOB # INPUT BY USER ;ATTACH... ;CHECK THAT USER-GIVEN JOB # IS IN LEGAL RANGE SETO D, GTB 3 ;MAX JOB # IS LENGTH OF SYS TABLE 3 MOVN A,A ;LENGTH COMES BACK NEGATIVE SUBI A,1 ;SO VALUE COMES OUT RIGHT IN ERR MSG CAML A,(P) ;LENGTH MUST BE > GIVEN # SKIPGE D,(P) ;GIVEN JOB # TO D ERROR ;MAKE SURE GIVEN JOB # IS LOGGED IN W MATCHING DIR # AND IS ATTACHED GTB 1 ;ENTRY NEG IF NO SUCH JOB JUMPL A,[UERR [ASCIZ/No job %4Q/]] GTB 0 ;LINE # OR NEGATIVE FOR DETACHED IN LH JUMPL A,ATAC4B HLRZ A,A ;TTY # ETYPE < [Attached to TTY%1O]> TLO KWV1,CONMAN ;REQUIRE CONFIRMATION IN THIS CASE ATAC4B: GTB 3 ;LOGIN DIR NO IN RH MOVEI A,(A) ;MASK DIR NO UNDER WH THIS JOB IS LOGGED IN JUMPE A,[UERR [ASCIZ /Job %4Q not logged in/]] MOVE E,-2(P) ;DESIRED DIRECTORY #, FOR USE IN ERR MSG CAME A,E ERROR JRST ATTAC7 ;GO CONFIRM AND EXECUTE ;ATTACH... ;NO JOB # GIVEN, SEE IF THERE IS A UNIQUE ONE FOR GIVEN NAME. ATTAC5: ;SEARCH SYSTEM TABLE 3 FOR A MATCH MOVE E,-1(P) ;DIR # TO SEARCH FOR (USED IN ERR MSGS!) SETO D, GTB 3 ;SYS TAB 3: BY JOB #, LOGIN DIR # IN RH. HRLZ D,A ;SET UP LENGTH,,INDEX FOR AOBJN & GTB. ATA5A: GTB 3 MOVEI A,(A) ;MASK THIS JOB'S LOGIN DIR # CAME A,E ATA5B: JRST [ AOBJN D,ATA5A ;LOOP ENDTEST UERR [ASCIZ /No detached job logged in under %5R/]] GTB 0 JUMPGE A,ATA5B ;IGNORE NON-DETACHED JOBS ;FOUND ONE, SEE IF ITS THE ONLY ONE. MOVEI B,(D) PUSH P,B ;SAVE JOB # OF JOB FOUND ATA5C: AOBJP D,ATTAC7 ;IF END OF TABLE, GO CONFIRM AND EXECUTE GTB 3 MOVEI A,(A) CAME A,E JRST ATA5C GTB 0 JUMPGE A,ATA5C ;IGNORE NON-DETACHED JOBS ERROR ;ATTACH... ATTAC7: CONFIRM ;EXECUTE THE COMMAND ;IF LOGGED IN, TYPE JOB # OF THIS JOB GJINF JUMPLE A,.+2 ETYPE < Detaching job # %3Q > ;ATTACH POP P,A ;TSS JOB # TO ATTACH TO POP P,C ;PASSWORD STRING POINTER POP P,B ;RH: DIR # TO ATTACH TO ;B0 OFF SAYS DON'T STOP IT ATACH CALL [ CAIN A,ATACX4 UERR [ASCIZ /Incorrect password/] ;NOTE THAT BAD PASSWORD IS DETECTED ABOVE ;IF NOT LOGGED IN JRST JERR] ;THIS JOB CONTINUES RUNNING IF LOGGED IN. GJINF ;GET TSS JOB # IN A JUMPG A,CMDIN4 ;LOGGED IN, GO GET NEXT COMMAND ;NOT LOGGED IN, ATACH FAILED TO KILL JOB, DO SO IN EXEC. SETO A, ;SAY SELF LGOUT ;KILL JOB CALL JERR ;LGOUT FAILED ;AVAILABLE [LINES/DEVICES] .AVAIL: KEYWD $AVAIL T LINES,,NOLOG+EOLOK,..TERM JRST CERR ;CAN'T CONFIRM HERE BECAUSE OF FUDGE-ENTRIES IN TABLE JRST (KWV) $AVAIL: TABLE T DEVICES,,NOLOG+EOLOK T LINES,,NOLOG+EOLOK,..TERM T T,,NSPALT+EOLOK+INVIS,<[UALTYP [ASCIZ /ERMINALS /] JRST ..TERM]> ;"T" = "TERMINALS" T TE,,NSPALT+EOLOK+INVIS,<[UALTYP [ASCIZ /RMINALS /] JRST ..TERM]> T TELETYPES,,EOLOK+INVIS,..TERM T TERMINALS,,EOLOK+INVIS,..TERM T TTYS,,EOLOK+INVIS,..TERM TEND ;AVAILABLE TERMINALS ..TERM: CONFIRM SETO D, ;TABLE LENGTH GTB 4 ;SYS TAB 4 IS LINE STATUS HRLZ D,A ;D IS AOBJN COUNT,,LINE # ;TLZ Z,F1 ;CLEAR TO SAY NOTHING PRINTED YET TERMI1: GTB 4 ;GET A LINE'S STATUS. HLRZ A,A ;LEFT HALF OF TABLE WORD CAIE A,-1 ;IS -1 FOR FREE LINES JRST TERMI9 CALL BEFORE ;TYPE COMMA OR MAYBE EOL ;TYPE ; ;DESIREABLE? HRRZ B,D CALL TOCT ;TYPE LINE NUMBER TERMI9: AOBJN D,TERMI1 TLNN Z,F1 TYPE < All lines in use> EOLRET: PRINT EOL ;COME HERE TO TYPE CRLF AND POPJ. RET ;AVAILABLE DEVICES ;DOES NOT LIST TTYS OR ANY NON-ASSIGNABLE DEVICES ;THIS LEAVES DTAS, MTAS, PTP, PTR, AND ANY OTHER DEVICES ADDED LATER. ;ALSO LISTS SEPARATELY DEVICES ALREADY ASSIGNED TO THIS JOB. .DEVIC: CONFIRM ;TLZ Z,F1 ;SAY NOTHING TYPED YET ;"DEVLUP" EXECUTES THE NEXT LOC FOR EACH DEVICE, WITH CALL DEVLUP ;...NAME IN A, DVCHR WORD IN B. CALL [ JUMPGE C,[RET] ;DONE IF ASSIGNED WITH ASND. TLNN B,B3 ;DONE IF NOT ASSIGNABLE RET LDB B,[POINT 9,B,17] ;EXTRACT DEVICE TYPE CAIN B,12 ;EXCLUDE TTYS ALSO RET CALL BEFORE ;SEPARATING CHARACTER(S) JRST SIXPRT] ;PRINT SIXBIT NAME TLNE Z,F1 PRINT EOL JRST ASTTJ ;LIST DEVS ASSIGNED TO THIS JOB. WITH FILSTAT. ;SUBROUTINE FOR FORMATTING A LIST OF ITEMS SEVERAL TO A LINE. ;USED FOR AVAILABLE TERMINALS, AVAILABLE DEVICES, FILSTAT, AND TRMSTAT ;BEFORE EACH ITEM: COMMA EXCEPT CRLF IF TOO FAR TO RIGHT. BEFORE: PUSH P,A PUSH P,B MOVE A,COJFN RFPOS MOVEI B,(B) ;MASK COLUMN POSITION CAIL B,^D65 JRST [ PRINT EOL JRST .+3] TLOE Z,F1 ;SUPPRESS COMMA BEFORE FIRST ONE PRINT "," PRINT " " ;SPACE AFTER COMMA OR EOL JRST [ POP P,B POP P,A RET] ;SUBROUTINE TO LOOP OVER ALL DEVICES FOR "AVAIL DEVICES" AND "FILSTAT". ;FOR EACH DEVICE, EXECUTES LOCATION AFTER CALL WITH SIXBIT NAME IN A ; DEVICE CHARACTERISTICS WORD (A LA "DVCHR" EXCEPT B5) IN B, ; -1 OR JOB # ASSIGNED TO IN C. ;RETURNS +2. ;DESTROYS A, B, C, D. DEVLUP: SETO D, GTB 6 ;GET # DEVICES FROM TABLE 6 HRLZ D,A ;AOBJN COUNT,,ABLE INDEX DEVL1: GTB 7 ;DEVICE CHARACTERISTICS WORD (TABLE 7) MOVE B,A GTB 10 ;GET JOB # ASS TO, OR -1, FROM LH TABLE 8 HLRE C,A GTB 6 ;GET DEVICE NAME IN SIXBIT FROM TABLE 6 PUSH P,D XCT @-1(P) POP P,D AOBJN D,DEVL1 JRST [ AOS (P) RET] ;TYPE SIXBIT SYMBOL FROM A. ;USED IN "AVAILABLE DEVICES", "SYSTAT", "STATISTICS", AND "FILSTAT". SIXPRT::PUSH P,B PUSH P,C MOVE C,A SIXPR1: SETZ B, LSHC B,6 ADDI B,40 CALL CCHRO JUMPN C,SIXPR1 JRST [ POP P,C POP P,B RET] ;BACKGROUND (fork) forkname (infile) oldfilespec (outfile) filespec (and) - .BACKGROUND: NOISE MOVE A,FORK ;Get fork handle CALL GETFH ; default current fork (if any) ALLOW TALT+TSPC+TEOL+TLPR NOISE MOVEI A,[ASCIZ /INP/] CALL CINFN JRST [ SETOM CJFN1 MOVE A,BHC+1 ADDM A,JBUFP JRST .+1] ALLOW TALT+TSPC+TEOL+TLPR NOISE MOVEI A,[ASCIZ /OUT/] CALL COUTFN JRST [ SETOM CJFN2 JRST BACK1] TRNE CBT,TSPC PRINT " " BACK1: ALLOW TALT+TSPC+TEOL+TLPR NOISE KEYWD $REDIR T -,,EOLOK,<[CMDIN4,,[RET]]> JRST CERR BACK2: HRRZ A,0(KWV) ; BCONTINUE JOINS HERE CALL 0(A) CONFIRM MOVE A,CJFN1 ;Open input file if necessary JUMPL A,.+3 MOVEI B,1B19 ;For read CALL $OPEN7 MOVE A,CJFN2 ;Open output file if necessary JUMPL A,.+3 MOVEI B,1B20 ;For write CALL $OPEN7 NOINT ;While non-interruptable, MOVE A,FORK ;Change primary JFNs for background fork GPJFN ; to those specified.. SKIPG CJFN1 FEATUR -%BAKTRP,< JRST .+4 > FEATUR %BAKTRP,< JRST [HRLI A,(1B0) PUSH P,2 MOVEI 2,IJTBTS TFORK CALL JERR HLLI A, POP P,2 JRST .+4]> HLRZ C,B EXCH C,CJFN1 HRLI B,(C) SKIPG CJFN2 FEATUR -%BAKTRP,< JRST .+4 > FEATUR %BAKTRP,< JRST [HRLI A,(1B0) PUSH P,2 MOVEI 2,OJTBTS TFORK CALL JERR HLLI A, POP P,2 JRST .+4]> HRRZ C,B EXCH C,CJFN2 HRRI B,(C) SPJFN FEATUR %BAKTRP,< TLO A,B0 ; GET DEFERRED INTERRUPT MASK ALONG WITH RTIW ; TERMINAL INTERRUPT WORD MOVEM B,FKTIW-.FH(A) ; SAVE IT MOVEM C,FKDIM-.FH(A) ; AND THIS ONE TOO SETZB B,C ; ZERO THEM OUT TLZ A,B0 STIW ; SHUT OFF TTY INTERRUPTS! HRLI A,(1B0) MOVEI B,PSIBTS TFORK ; TRAP APPROPRIATE PSI JSYSES CALL JERR HLLI A, > OKINT CALL RLJFNS ;Release stacked JFN's MOVSI B,FK%BAK+FK%KPT ;Mark fork background and kept IORM B,FKFLG-.FH(A) HLRZ A,0(KWV) JRST 0(A) FEATUR %BAKTRP,< OJTBTS: 1B9!1B16!1B24!1B33 ; ERSTR,GTJFN,JFNS,DIRST 1B5!1B7!1B24!1B26 ; BOUT,SOUT,PBOUT,PSOUT 1B9 ; DEVST BLOCK 1 1B0!1B4!1B8!1B11!1B13 ; ODTIM,NOUT,ODTNC,FLOUT,DFOUT 1B10!1B23 ; CVHST,ESOUT 1B4 ; GPSGN BLOCK ^D8 IJTBTS: 1B16 ; GTJFN 1B4!1B6!1B23 ; BIN,SIN,PBIN BLOCK 2 1B1!1B5!1B9!1B10!1B12 ; IDTIM,NIN,IDTNC,FLIN,DFIN BLOCK ^D10 PSIBTS: BLOCK 2 1B17!1B23 ; AIC,ATI 1B15!1B16 ; RTIW,STIW BLOCK ^D11 > ; BCONTINUE (FORK) -- ; SAME AS BACKGROUND (FORK) FORK (INFILE) - (OUTFILE) - (AND) CONTINUE .BCONTINUE: MOVE A,FORK CALL GETFH ALLOW TALT+TSPC+TEOL SETOM CJFN1 SETOM CJFN2 MOVE A,BHC+1 ADDM A,JBUFP MOVE A,$REDIR+1 HLRZS A MOVE KWV,(A) JRST BACK2 ;BLANK (SCREEN) ;THIS ONLY WORKS ON SITES THAT HAVE REASONABLE TERM TYPE NUMBERS ;I THINK IT IS NOW INCONSISTANT SO IT WORKS AT SRI FOR TERMINAL ;TYPE 14 FOR THE DATA-MEDIAS AND AT ISI FOR THE HP'S. ;IT SHOULD BE STRAIGHTENED OUT LATER. BES NOBBN < .BLANK: NOISE (screen) CONFIRM BLANK1: CALL GCTTY ;ONLY ON CONTROLLING TTY RET GTTYP CAIL B,14 CAILE B,26 RET ;UNKNOWN BLANK SEQUENCE MOVE D,BPTRS-14(B) ;PICK UP SEQUENCE POINTER RFCOC PUSH P,B PUSH P,C MOVE B,[BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2] MOVE C,[BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2] SFCOC BLANK2: ILDB B,D CAIN B,377 JRST BLANK3 BOUT JRST BLANK2 BLANK3: POP P,C POP P,B SFCOC RET BPTRS: POINT 8,[BYTE (8) 36,35,377] ;14 DM2500 POINT 8,[BYTE (8) 377] ;15 POINT 8,[BYTE (8) 33,"E",377] ;16 HP POINT 8,[BYTE (8) 14,377] ;17 C100 POINT 8,[BYTE (8) 33,"H",33,"J",377] ;20 TL1061 POINT 8,[BYTE (8) 377] ;21 POINT 8,[BYTE (8) 33,"[","H",33,"[","J",377] ;22 VT100 POINT 8,[BYTE (8) 33,"H",33,"J",377] ;23 H19 POINT 8,[BYTE (8) 33,"H",33,"J",377] ;24 VT52 POINT 8,[BYTE (8) 33,"[","H",33,"[","J",377] ;25 AMBASSADOR POINT 8,[BYTE (8) 177,220-176,377] ;26 IIMLAC > ;BREAK (LINKS) .BREAK: NOISE BREAK1: CONFIRM CALL GCTTY ;Check if there is a controlling tty RET ;Noop if not NOINT HRLOI 1,(1B0+1B1) ;BREAK TO AND FROM CONTROLLING JRST BREAK3 BREAK2: CALL GCTTY ;Get controlling tty RET ;Noop if none NOINT ;BE SURE TO DO BOTH TLINK AND ADVIZ HRLOI 1,(1B0+1B1+1B4) ;BREAK TO AND FROM CONTROLLING BREAK3: MOVEI 2,-1 ;ALL REMOTES, AND "REFUSE" TLINK CALL JERR MOVSI 1,(1B0) ;BREAK ADVISE LINKS ADVIZ CALL JERR OKINT RET ;CANCEL ALERT/MAILWATCH/PRINTERWATCH ;LATER: CANCEL ALERT (FORK TIME) .CANCEL: KEYWD $CANCEL FEATUR %ALERT,< TE ALERT,,,ALRTIM> FEATUR -%ALERT,< 0> JRST CERR CONFIRM SETOM (KWV) RET $CANCEL:TABLE FEATUR %ALERT,< TE ALERT,,,ALRTIM> FEATUR %DAEMON,< TE DAEMON,,,DAENAM> TE MAILWATCH,,,MSGTIM TE PRINTERWATCH,,,PRNTIM TEND ;CAPABILITIES AND CAPSTAT .CAPSTAT: .CAPABILITIES: NOIAC < RET > IAC < JRST NIYE## > ;"CHANGE" COMMAND .CHANGE: TRNE CBT,TEOL JRST C.ACT1 ;DEFAULT TO ACCOUNT KEYWD $CHANG TE ACCOUNT,,,C.ACCT JRST C.ACCT JRST 0(KWV) $CHANG: TABLE T ACCOUNT,,,C.ACCT T PASSWORD,,,C.PSWD TEND ;"CHANGE ACCOUNT (TO) ..." C.ACCT: CAIN CNT,1 C.ACT1: TLO Z,F1 ;INDICATE LONG PROMPTING ;DETERMINE WHETHER LOGGED IN USER TAKES STRING OR NUMERIC ACCT ..ACNT: GJINF ;LOGIN DIR # TO A MOVE B,A MOVE A,CSBUFP ;STRING BUFFER PTR DIRST ;CONVERT DIR # TO STRING CALL SCREWUP MOVEI A,1 MOVE B,CSBUFP STDIR ;CONVERT BACK TO # PLUS BITS CALL SCREWUP CALL SCREWUP ;NOW B1 OF A ON FOR STRING ACCT. FINISH INPUTTING COMMAND. TLNE Z,F1 ;LONG PROMPTING MESSAGE? JRST [ TLNN A,B1 $TYPE <(account # to) > TLNE A,B1 $TYPE <(account to) > JRST C.ACT2] TLNN A,B1 ;NOISE DEPENDS ON WHETHER USER TAKES... NOISE <# to> ;NUMERIC ACCOUNT, TLNE A,B1 NOISE ;OR STRING. C.ACT2: CALL ACCT ;INPUT, CHK, CNVT ACCT INTO A (USES A ) CONFIRM CALL PIE.P ;SKIP IF PIESLICE SYSTEM JRST C.ACT3 PUSH P,A ;SAVE NEW ACCOUNT ADD P,BHC+10 ;NO CHECK FOR POV _____ MOVEI A,-7+0(P) ;WHERE TO PUT STRING ACCT SETO B, ;SAY THIS JOB GACTJ ;GET CURRENT ACCOUNT CALL JERR ETYPE < Time used on account %1M: %B in %C> SUB P,BHC+10 POP P,A ;NEW ACCOUNT JRST C.ACT4 C.ACT3: ETYPE < Time used on previous acct: %B in %C> C.ACT4: SETZ B, ;NO SPECIAL FUNCTION BITS CACCT ;JSYS TO CHANGE ACCOUNT # CALL JERR RET ;"CHANGE PASSWORD (OF DIRECTORY) ... (FROM) ... (TO) ... (TO) ... " C.PSWD: CALL BREAK2 ;DO "BREAK" AND "REFUSE" CALL SPECEOL ;MAKE EOL FORCE NOISE NOISE CALL DIRNAM ;INPUT AND CHECK DIRECTORY NAME PUSH P,A ;BITS,,# FROM STDIR PUSH P,B ;POINTER TO BUFFERED NAME STRING ALLOW TSPC+TALT+TEOL ALTYPE ( ) CALL SPECEOL ANDI A,-1 ;KEEP ONLY DIR NUM MOVNS A ;SPECIAL NOISE & CHECK IT CALL PASWD ;INPUT AND CHECK PASSWORD PUSH P,A ;SAVE POINTER TO IT ALLOW TSPC+TALT SETZ A, ;SAY DON'T CHECK PASSWORD CALL PASWD ;INPUT NEW PASSWORD PUSH P,[0] ;CRDIR BLOCK BEGINS HERE PUSH P,A ;SAVE POINTER TO IT ALLOW TALT+TSPC+TEOL ILDB B,A ;GET FIRST CHR OF NEW PASSWORD JUMPE B,CERR ;WILL BE HARD TO LOGIN IF PSWD IS NULL SETZ A, ;SAY DON'T CHECK PASSWORD CALL PASWD ;AND INPUT NEW PASSWORD (AGAIN) ALLOW TSPC+TALT+TEOL MOVE B,(P) ;POINTER TO FIRST COPY ILDB C,A ;GET A CHAR FROM 2ND STRING ILDB D,B ;AND ONE FROM 1ST STRING CAME C,D ;SAME? ERROR JUMPN C,.-4 ;UNTIL NULL BYTE CONFIRM C.PSW1: MOVE 1,-3(P) ;POINTER TO OLD NAME MOVSI 2,(1B1) ;"SET PASSWORD" BIT HRRI 2,-1(P) ;PARAMETER BLOCK LOCATION (PARTIAL) MOVE 4,-2(P) ;NEW PASSWORD CRDIR XJMP C.PSWT ;JUMP ON ITRAP SUB P,BHC+5 ;FLUSH JUNK RET ;CRDIR TRAPS TO HERE C.PSWT: CAIN 1,CRDIX1 ERROR ;THE FOLLOWING SHOULD REALLY SIMULATE A CALL TO JERR IF IT DID NOT ;TRAP (PC SHOULD POINT JUST AFTER CRDIR) BUT IF IT DID TRAP THEN ;THE FOLLOWING IS CORRECT (PC PICKED UP FROM LEV1PC) JRST ILITRP## ;CLEAR (DIRECTORY OF DEVICE) ;FORCED CONFIRMATION .CLEAR: NOISE CALL DEVN ;GET DEVICE DESIGNATOR (IN A) LDB D,[POINT 9,A,17] ;DEVICE TYPE CAIE D,3 ERROR TLNN B,B5 ;AVAILABLE? JRST [ TLNN B,B6 ;ASSIGNED? UERR [ASCIZ /%1H: Not available/] UERR [ASCIZ /%1H: Assigned to job %3O/]] TLNN B,B8 ERROR <%1H: Not mounted> CONFIRM INIDR ;INITIALIZE DIRECTORY (DESIGNATOR IN A) CALL JERR RET ;CONNECT (TO DIRECTORY) (PASSWORD) -- ;(IF A WAY IS PROVIDED TO FIND OUT WHETHER A GIVEN DIRECTORY ; REQUIES A PASSWORD, MAKE IT REQUEST PASWD ON NEXT LINE (LIKE LOGIN) ; INSTEAD OF ASSUMING NULL IF NAME IS TERMINATED WITH CR BUT THIS ; DIRECTORY REQUIRES A PASSWORD). .CONNE: GJINF ;GET DIRECTORY NUMBERS HRRZ D,B ;SAVE CONNECT DIRECTORY FROM USER TRNE CBT,TEOL ;EOL MEANS SKIP DIRNAM JRST CONNE1 NOISE CALL USER ;INPUT & CHECK DIRECTORY NAME CONNE1: CAIN D,(A) ;IF SAME AS CURRENT CONNECT DIRECTORY TLO Z,F1 ; FLAG SO AS NOT TO PRINT DISK MISMATCH PUSH P,A ;DIR # ETC AS RETURNED BY "STDIR" ALTYPE ( ) ALLOW TSPC+TALT+TEOL ;PASSWORD IS SECOND, OPTIONAL ARGUMENT HRROI A,[ASCIZ //] ;USE NULL IF OMITTED TRNE CBT,TEOL JRST CONNE4 HRRZ A,0(P) ;DIRNUM FOR PASWD CALL PASWD ;INPUT & CHECK PASSWORD CONNE4: ALLOW TALT+TSPC+TEOL CONFIRM PUSH P,A ;SAVE TEXT PTR TO PASSWD CALL CHKDAL ;CHECK CURRENT DIRECTORY BEFORE LEAVING POP P,B HRRZ A,(P) ;DIRECTORY # CNDIR CALL [ CAIN A,CNDIX1 UERR [ASCIZ /Incorrect password/] JRST JERR] SUB P,BHC+1 TLNE Z,F1 ;Any change? RET ;No, done ETYPE < [From %4R] > CALL CHKDAL ;CHECK NEW DIRECTORY RET ;CONTINUE ;RESUMES FROZEN INFERIOR FORKS ;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH ;DECIDE WHICH FORK TO CHECK ON ; WHEN THIS ROUTINE IS CALLED, "FORK" SHOULD CONTAIN THE CURRENT FORK ; HANDLE OR A VALID FORK HANDLE. IT SHOULD CONTAIN -1 ONLY IF THERE ; IS NO CURRENT FORK AND NO VALID FORK WAS SPECIFIED (ON TYPEIN) $CONTI: SKIPGE A,FORK ;HANDLE OF AN INFERIOR FORK ERROR ;NO INFERIOR TO CONTINUE CALL FNDFSB ;GET A POINTER IN STRUCTURE PUSH P,B ;SAVE IT CALL FTPFKB ;GET THE IMMEDIATE INFERIOR FOR IT HRRZ A,1(B) ;HANDLE MOVE C,0(P) ;Original pointer into structure JUMPE A,$CONT2 ;NO HANDLE (DON'T THINK THIS CAN HAPPEN) MOVE B,FKFLG-.FH(A) ;FORK FLAGS TLNN B,FK%STD ;HAS IT BEEN STARTED? ERROR FEATUR %BAKTRP,< SETCA B, TLNE B,FK%BAK!FK%TRP ; A TRAPPED BACKGROUND FORK? JRST $CONT2 ERROR > $CONT2: HRRZ A,1(C) ;HANDLE RFSTS TLZ B,B0 ;IGNORE FROZEN BIT HLRZ B,A ;STATUS CAIE B,4 ;FORK WAIT? MOVEM C,0(P) ;HIGHEST FORK NOT IN FORK WAIT HLRZ C,1(C) ;SUPERIOR POINTER CAIE C,FKSTC ;THIS FORK BLOCK JRST $CONT2 POP P,B ;BLOCK POINTER HRRZ A,1(B) ;FORK HANDLE MOVEM A,FORK RET ;FIND FORK STRUCTURE BLOCK ;A/ HANDLE OR NUMBER DESIRED ;RETURNS +1 ; A/ HANDLE ; B/ POINTER TO BLOCK (GFRKS ENTRY) ; C/ SAME AS B FNDFSB::CALL $GFRKS ;GET A STRUCTURE (START AT FKSTC) TRO A,.FH ;BE SURE OF HANDLE SETZ B, ;RETURN 0 IF NOT FOUND MOVEI C,FKSTC ;START OF SCAN CALL FNDFSP SKIPN C,B CALL SCREWUP RET ;FIND FORK STRUCTURE FROM POINTER ;A/ HANDLE ;C/ POINTER TO STRUCTURE FNDFSP: PUSH P,C ;BLOCK WE ARE AT HRRZ D,1(C) CAIN D,(A) JRST [ POP P,B RET] ;FOUND IT RETURN POINTER HRRZ C,0(C) ;DO INFERIORS JUMPE C,FNDFS1 ; IF ANY CALL FNDFSP JUMPN B,[ POP P,C RET] FNDFS1: POP P,C ;GET BACK POINTER HLRZ C,(C) ;DO PARALLELS JUMPN C,FNDFSP ;AT SAME LEVEL RET ;FIND TOP FORK (IMMEDIATE INFERIOR) ;POINTER IN A (ENTRY IS FTPFKA) ;POINTER IN B (ENTRY IS FTPFKB) ;POINTER RETURNED IN B FTPFKA: MOVE B,A FTPFKB::HLRZ A,1(B) ;SUPERIOR POINTER CAIE A,FKSTC ;TOP FORK JRST FTPFKA RET $GFRKS: SKIPE FKSTCF RET ;ALREADY HAVE STRUCTURE PUSH P,A PUSH P,B MOVEI A,.FHSLF MOVEI B,FKSTC ;WHERE TO STORE IT GFRKS ERJMP ILITRP## SETOM FKSTCF POP P,B POP P,A RET ;"CONTINUE" COMMAND DISPATCHES HERE .CONTI: CALL GFRKNM ;WHICH FORK SCRC < SKIPG A,FORK ;IS THERE ONE TO CONTINUE NOW? JRST .+3 TRZ A,.FH ;MAKE FORK NUMBER FOR CIFORK MOVEM A,CIFORK >;SCRC CALL $CONTI CONFIRM ;"REDIRECT/DETACH ... (AND) CONTINUE" JOINS HERE ..CONT: SETOM A CALL MAPPF ;UNMAP ANY PAGE OF USER MOVE A,FORK ;FORK TO MANIPULATE RFSTS ;FIND OUT WHY IT STOPPED HLRZ C,A TRZ C,B0 ;FLUSH FROZEN BIT MOVE A,FORK CAIE C,2 ;FORK WAS HALTED OR FORCE TERM? CAIN C,3 SFORK ;YES. START IT CALL IFORK ;TRACE UP STRUCTURE CALL SFKTTM## ;SET TTY STUFF TLO Z,RUNF ;SAY SO. JRST $WAIT ;GO RESUME FORK AND WAIT FOR IT ;"COPY" IS IN X2CMD.MAC. ; "CORRECT" IS IN SPLCOR.MAC FEATUR %DAEMON,<;CONDITIONAL COMMANDS ; ROUTINES FOR THE "DAEMON" FEATURE ; .DAEMO IS THE COMMAND PROCESSOR FOR THE "DAEMON" COMMAND: ; @DAEMON (FILE) DEMON.SAV (EVERY) N ; WHERE N IS A NUMBER OF MINUTES. ; CANCELING THE DAEMON IS IN THE CANCEL COMMAND ; @CANCEL DAEMON ; CKDAEM IS CALLED IN THE MAIN COMMAND RECOGNITION LOOP, AND STARTS ; THE DAEMON IF IT'S TIME. ; STDAEM IS CALLED TO START UP THE DAEMON. STDAEM: TIME ;FIRST SET UP NEXT TIME ADD 1,DAEINC MOVEM 1,DAENXT HRROI B,DAENAM ;THEN TRY TO OPEN IT CALL TRYGTJ RET ;NOT THERE, TRY AGAIN LATER JRST ERUN2 ;RUN EPHEMERAL RETURNS TO TOP OF COMMAND LOOP CKDAEM: SKIPG DAENAM RET ;NO DAEMON INITIATED TIME CAML 1,DAENXT JRST STDAEM ;IT'S TIME! RET .DAEMO: SKIPLE DAENAM ERROR CALL $GET1 MOVE A,[^D300000] ;DEFAULT 5 MINUTES TRNE CBT,TEOL JRST DAEM1 NOISE (every) CALL DECIN JRST [ UALTYP [ASCIZ /5/] MOVE A,[^D300000] ;5-MINUTES IN MILLS JRST DAEM1] JUMPLE A,CERR ;MUST BE POSITIVE IMULI A,^D60000 ;CONVERT MINUTES TO MILLS DAEM1: CONFIRM MOVEM A,DAEINC MOVE B,CJFN1 ;WE'VE GOT AN INCREMENT, HRROI A,DAENAM ;SO NOW WE CAN PUT NAME AWAY MOVE C,[2B2!1B5!1B8!1B11!1B35] JFNS CALL RLJFNS JRST STDAEM ;START IT UP RIGHT NOW >;END CONDITIONAL COMMANDS ;DAYTIME ;THIS AND ALL ONE-WORD COMMANDS ARE CONFIRMED BEFORE DISPATCH. .DAYTI: PRINT " " MOVE A,COJFN ;DESTINATION SETOB B,C ;SAY CURRENT DATE AND TIME, SUPER-VERBOSE FORMAT ODTIM PRINT EOL RET ;DELETE .DELET: MOVE A,BHC+2 ;SAY DEFAULT NAME & EXT TO PREVIOUS HRLI B,-2 ;DEFAULT VERSION TO LOWEST HRRI B,B2+B11+B15+B16 ;OLD FILE, *'S AND COMMA OK CALL SPECFN ;INPUT FILE GROUP DESCRIPTOR JRST CERR ALLOW TSPC+TALT+TEOL CONFIRM CALL FRSTF ;TYPE NAME IF A GROUP DELET0: HRRZ A,@INIFH1 ;JFN DVCHR TLNN B,(1B4) ;DISK? JRST DELET1 ;NO HRRZ A,@INIFH1 DELET2: MOVE B,[1,,FDBCTL] ;GET CONTROL BITS MOVEI C,C ;TO C CALL $GTFDB ;GET FDB OR DON'T SKIP ERROR TLNE C,(FDBUND) ;CHECK THE PERPETUAL BIT JRST [ TYPE < Perpetual file -- cannot delete > JRST NEXTF] ;DO NEXT FILE DELET3: MOVE B,[1,,FDBBCK] ;GET BACKUP WORD MOVEI C,C ;TO C CALL $GTFDB ERROR <$GTFDB error> TLNE C,FDBARC ;ARCHIVE BIT JRST [ TYPE < Archive-pending -- cannot delete > JRST NEXTF] ;RETURNS TO FRSTF CALL +1 DELET1: MOVE A,@INIFH1 ;JFN(FLAGS TELL DELF WHETHER TO RELEASE) DELF CALL [ CAIN A,DELFX1 ERROR JRST JERR] JRST NEXTF ;GET NEXT FILE IF GROUP, TYPE NAME, ;RETURN TO WHERE FRSTF WAS CALLED. ;GO TO RLJFNS IF NO MORE FILES. ;"DDT" COMMAND. LOAD DDT IN INFERIOR FORK IF NECESSARY, ;TRANSMIT SYMBOL TABLE POINTER, START DDT. .DDT: ;DETERMINE WHETHER THERE IS INFERIOR FORK WITH SYMBOL TABLE POINTER ;IF NOT, USE DDT THAT ALREADY CONTAINS STENEX SYMBOLS. SETZ C, ;SAYS NO SYM TAB PTR SKIPGE A,FORK JRST DDT2 ;NO FORK TRZ A,.FH ;MAKE FORK NUMBER JUMPE A,.EDDT ;IF FORK 0, GO TO EDDT MOVE B,FKFLG(A) TLNE B,FK%ACT ;Disallow if fork still active ERROR <%1F not suspended> TLNE B,FK%DDM ;DDT ALREADY LOADED? JRST DDT4 ;THERE IS A FORK, SEE IF IT ALREADY CONTAINS SOMETHING THAT LOOKS ;LIKE A DDT. IF SO, LEAVE IT, AS IT MAY CONTAIN BREAKPOINTS, ;MODIFIED SYM TAB PTR, ETC. MOVEI A,DDTORG ;DDT BEGINNING ADDRESS CALL MAPPF TLNN A,B5 ;PAGE EXISTS? JRST DDT1 ;NO, FORK DOESN'T HAVE DDT CALL LOADF ;YES, LOAD FIRST WORD CAME A,[JRST DDTORG+2] JRST DDT1 MOVEI A,DDTORG+1 CALL LOADF ;SECOND WORD IS 0,,PTR PTR CAIG A,-1 CAIG A,DDTORG JRST DDT1 JRST DDT3 ;ALREADY HAVE ACCEPTABLE DDT ;FORK DOESN'T HAVE DDT, SEE IF IT HAS SYM TAB PTR DDT1: MOVEI A,.JBSYM ;WHERE LOADER LEAVES SYM TAB PTR CALL MAPPF ;MAP PAGE OF FORK ;SETZ C, ;SAYS NO SYM TAB PTR TLNE A,B5 ;NO PAGE? TLNN A,B2 ;READ PROTECT? JRST DDT2 ;NO USEABLE PTR ;ANDI A,777 MOVE C,PAGEN(A) ;FETCH SYM TAB PTR WORD ;IF NEGATIVE, IT WILL BE ASSUMED TO BE PTR MOVE D,PAGEN+1(A) ;.JBUSY IS .JBSYM+1 ;NO CHECKING NEEDED, DDT WILL FIX IT UP. ;DDT... DDT2: PUSH P,C ;SAVE SYM TAB PTR OR 0 PUSH P,D ;SAVE UNDEF SYM PTR MOVE B,[POINT 7,[ASCIZ /SDDT.SAV/]] ;DDT WITH SYMBOLS JUMPGE C,.+2 ;SYM TAB PTR CANT BE .GE. 0 MOVE B,[POINT 7,[ASCIZ /UDDT.SAV/]] ;LOAD SELECTED DDT CALL $GTJFN ;ASSIGN JFN FOR STRING PTR IN B CALL $MERGE ;MERGE IT INTO FORK, CREATE FORK IF NONE, ;AND RELEASE JFN ;STORE SYMBOL TABLE POINTER POP P,D POP P,C JUMPGE C,DDT3 ;NOT A SYMBOL TABLE POINTER MOVEI A,DDTSYM CALL MAPPF ANDI A,777 HRRZ E,PAGEN+1(A) ;WHERE TO STORE UNDEF PTR HRRZ A,PAGEN(A) ;POINTER TO WHERE TO PUT POINTER CALL MAPPF ANDI A,777 MOVEM C,PAGEN(A) ;STORE POINTER HRRZ A,E ;WHERE TO PUT UNDEF PTR IN DDT CALL MAPPF ANDI A,777 MOVEM D,PAGEN(A) ;STORE IT DDT3: MOVE A,FORK ;FORK HANDLE TRZ A,.FH ;BECOMES FORK NUMBER MOVSI B,FK%DDM ;DDT LOADED FLAG IORM B,FKFLG(A) ;SAY DDT LOADED!! ;TRANSFER CONTROL TO DDT DDT4: MOVNI B,3 ;CODE FOR PA1050 IF ANY CALL CHKPAT ;PA1050 RUNNING IN FORK? JUMPG B,GOTO2 ;RETURNS RESTART ADDRESS IF YES MOVEI B,DDTORG ;DDT STARTS AT ITS FIRST LOCATION JRST GOTO2 ;JOIN "GOTO" COMMAND: UNMAP PAGE, START FORK. ;DEASSIGN ;ACCEPTS LOGICAL OR REAL DEVICE NAME .DEASS: NOISE (device) CALL DEVN ;INPUT DEVICE NAME ;NOW HAVE DEVICE DESGNATOR IN A, CHARACTERISTICS WORD IN B. TLNN B,B6 ERROR <%1H: Not assigned> TLNN B,B5 ERROR <%1H: Not assigned to you> CONFIRM TLNE B,B8 ;MOUNTED? TLNN B,B7 ;MOUNTABLE? JRST .+3 ;NOT MOUNTED OR NOT MOUNTABLE DSMNT ;REDUCES CHANCES OF CLOBBEREING NEXT CALL JERR ;...USER'S DECTAPE. RELD CALL JERR RET ;"DETACH" CODE IS WITH "REDIRECT" IN X2CMD. ;"DOWNTIME" COMMAND ; JUST OUTPUTS EVERYTHING FROM SCHEDULED.DOWNTIME TO COJFN SRI < .DOWNT: HRROI B,[ASCIZ /SCHEDULED.DOWNTIME/] CALL TRYGTJ JRST DWNTM4 MOVEI B,1B19 CALL $OPEN7 CALL TYPIT JRST RLJFNS ;TYPED, GO RELEASE IT AND RETURN. ; TYPE ALL OF FILE WHOSE JFN IS IN A, AND RETURN. TYPIT: PUSH P,A ;STACK JFN OF OPEN FILE HRRZI B,DWNTM2 MOVEM B,EOFDSP ;ARM EOF INT TO HERE DWNTM1: BIN MOVE A,COJFN BOUT MOVE A,(P) ;GET INFIL JFN JRST DWNTM1 DWNTM2: SUB P,BHC+1 ;FLUSH MY COPY OF JFN RET ;RETURN FROM TYPIT DWNTM4: CALL CRIF TYPE JRST RLJFNS > ;EDIT (FILE) [] ;Fires up TECO, SOS, XED, and TV, at CCL entry with JFN of file ;specified in AC1, starts up POET in its funny manner (get DSR to fix it). ;The EDITOR to be used once set is remembered until it is reset. ;A pointer is kept in EDITOR which is saved until logout. ; THE DEFAULT FILE IS A RECENT VERSION OF THE LAST ONE MENTIONED ; IN AN "EDIT" COMMAND. THE ACTUAL NAME OF THIS IS SAVED AWAY IN ; "EDFILE" SO THAT IT IS PRESERVED THROUGH RESETS. .EDIT: CALL CEDFN ;GET EDIT FILE NAME,DEFAULT=PREVIOUS JRST EDIT7 ;NO FILE SPECIFIED TRNE CBT,TSPC PRINT " " CAIN TRM,EOL JRST [ MOVEI TRM,SPACE MOVE CBT,CHRTBL(TRM) DPB TRM,BFP ;OVER THE EOL JRST .+1] PUSH P,A ;SAVE THE JFN FOR STARTING THE EDITOR DVCHR TLNE B,777 ERROR CALL EDITR MOVE A,[EDFILE,,EDFILE+1] SETZM -1(A) ;CLEAR DEFAULT POINTERS WORD BLT A,EDFILE+EDFILL-1 ;AND SAVED STRINGS EDIT1: HRROI A,EDFILE+1 ;BEG OF STRING STORAGE MOVE B,0(P) ;EDIT JFN HRLZM A,EDFILE ;SET NAME HALF OF POINTER WORD MOVSI C,(1B8) ;OUTPUT NAME OF JFN JFNS IBP A ;INSERT A NULL HRROI A,1(A) ;BUMP TO NEXT WORD HRRM A,EDFILE ;SET EXT HALF OF POINTER WORD MOVSI C,(1B11) ;OUTPUT EXT OF JFN JFNS EDIT2: MOVE A,0(P) ;GET EDIT JFN AGAIN MOVE B,[1,,FDBCTL] MOVEI C,C ;INTO C CALL $GTFDB ;GTFDB OR DON'T SKIP JRST CERR MOVEI B,1B20 ;WRITE TLNE C,(FDBNXF) ;FIRST WRITE DONE TLOA Z,F1 ;NO. SAY SO - SEE IF IT IS OK MOVEI B,1B19 ;YES, THEN READ CALL $OPEN7 ;7 BIT FANCY OPENER TLO A,(1B0) ;DONT RELEASE THE JFN CLOSF ;THE EDITOR WILL OPEN IT CALL SCREWUP EDIT3: MOVE A,EDITOR IMULI A,3 MOVE B,EDITBL-3(A) ;POINTER TO EDITOR FILE CALL TRYGTJ ERROR <%2W not available> PUSH P,A EDIT4: CALL $RESET ;FLUSH CURRENT FORK CALL ECFORK ;CREATE A FORK FOR EDITOR MOVE A,EDITOR IMULI A,3 MOVE A,EDITBL-2(A) ;NAME OF EDITOR CALL FRKNAM JFCL ;FORGET IT IF NAME IN USE MOVE A,CIFORK ;EDITOR FORK IMULI A,SFKBLK MOVE C,EDITOR IMULI C,3 MOVE C,EDITBL-1(C) ;SIXBIT NAME OF EDITOR MOVEM C,FK.SNM(A) ;SIXBIT NAME POP P,A ;JFN! HRL A,FORK GET ERJMP GETILI EDIT5: MOVE A,EDITOR CAIN A,E.POET ;POET? SKIPN EDFILE ;AND A FILE? JRST .+2 JRST EDPOET ;MUST HANDLE SPECIALLY MOVEI A,1 ;AC1 CALL MAPPF POP P,PAGEN+A ;JFN MOVE A,FORK MOVEI B,PAGEN SFACS JRST EDIT6 ;UNTIL D. S. RUSSELL FIXES POET IFCRJP==767000 ;SPECIAL LOCATION (READ) IFCWJP==767001 ;WRITE JFN IFCTXT==767040 ;BUFFER SPACE EDPOET: MOVEI A,IFCRJP CALL MAPPF ;GET THE RIGHT PAGE HRROI A,PAGEN ;WINDOW ADDI A, ;DISPLACEMENT POP P,B ;JFN SETZ C, ;DEFAULT FORMAT JFNS ;PASS STRING TLZE Z,F1 ;NEW FILE JRST [ SETZ A, HRROI B,IFCTXT JRST EDIT5A] ;YES. FORGET READ HRROI A,IFCTXT HRLOI B,500000 ;NORMAL OVERWRITE EDIT5A: MOVEI C,PAGEN MOVEM A,(C) MOVEM B,(C) CALL RLJFNS MOVE A,FORK EDIT6: MOVE B,EDITOR SKIPE B,EDFILE ;EDFILE=0 IF NO FILE SPECIFIED MOVEI B,2 ;CCL ENTRY JRST START1 ;START IT UP EDIT7: SKIPN A,EDFILE ;IS THERE A SAVED FILE NAME.EXT? JRST EDIT9 ;NO MOVE B,[CJFNBK,,CJFNBK+1] SETZM -1(B) BLT B,CJFNBK+10 ;CLEAR DEFAULT BLOCK HLROM A,CJFNBK+4 ;DEFAULT NAME HRROM A,CJFNBK+5 ;DEFAULT EXTENTION MOVE B,[377777,,377777] MOVEM B,CJFNBK+1 ;NO IO MOVSI C,100000 MOVEM C,CJFNBK+0 ;OLD FILE ONLY, NO CONFIRM EDIT8: MOVEI A,CJFNBK ;DEFAULT BLOCK PTR MOVEI B,0 ;FORCE DEFAULTING GTJFN JRST CERR ;ANOTHER DIRECTORY OR DELETED ;MAYBE SHOULD CLEAR EDFILE MOVE B,JBUFP PUSH B,A ;SAVE FOR RELEASING ON ERROR,ETC MOVEM B,JBUFP EDIT9: PUSH P,A ;WHERE REST OF EDIT WANTS THE JFN CALL EDITR JRST EDIT3 ;FILE KNOWN TO EXIST EDITR: KEYWD $EDITR TE (,,NSPALT,-1) ;DEFAULT IS LAST EDITOR JRST CERR HRREI A,(KWV) JUMPGE A,EDITR1 SKIPG A,EDITOR MOVEI A,DFEDIT ;DEFAULT EDITOR MOVEI B,-1(A) IMULI B,3 UALTYP @EDITBL+1(B) ALTYPE ( ) EDITR1: PUSH P,A ;EDITOR NUMBER CONFIRM POP P,EDITOR RET DEFINE EDITAB (EDITOR)< $EDITR: TABLE IRP EDITOR,< IFIDN , IFIDN , TE EDITOR,,,.-$EDITR> TEND EDITBL: IRP EDITOR,< POINT 7,[ASCIZ "'EDITOR'.SAV"] POINT 7,[ASCIZ "EDITOR"] SIXBIT /EDITOR/> > ;EDITOR LIST -- MUST BE ALPHABETICAL EDITAB ;ENTRY (VECTOR LOCATION) (LENGTH) .ENTRY: SKIPGE FORK ERROR NOISE CALL OCTAL JRST CERR ALLOW TALT+TEOL+TSPC PUSH P,A MOVEI A,1 ;DEFAULT LENGTH TRNE CBT,TEOL JRST ENTRY5 NOISE CALL OCTAL ;OCTAL TO ALLOW 254000 FOR COMPATIBILITY JRST [ UALTYP [ASCIZ /1 /] ;NULL INPUT MOVEI A,1 ;DEFAULT LENGTH AGAIN JRST .+1] ALLOW TALT+TEOL+TSPC CAIN A,1050 ;ANOTHER NAME FOR 254000 MOVEI A,(JRST) ; CAILE A,777 ;TOO LONG? CAIN A,(JRST) ;10-50 ENTRY VECTOR ? JRST ENTRY5 ;ENTRY VECTOR OK JRST CERR ; (?) ENTRY5: CONFIRM POP P,B ;LOCATION HRL B,A ;LENGTH MOVE A,FORK SEVEC RET SCRC < ;"NOT AUTOKEEP" .NOTAU: TDZA 1,1 ;"AUTOKEEP" TURNS ON THE FDBKEP BIT .AUTOK: SETO 1, PUSH P,1 PUSH P,[FDBKEP] JRST EPHEM1 > ;"NOT EPHEMERAL" TURNS OFF FDBEPH BIT IN FDB .NOTEP: TDZA 1,1 ;0 FOR USE IN CHFDB ;"EPHEMERAL" TURNS ON THE FDBEPH BIT .EPHEM: SETOM 1 ;1 FOR USE IN CHFDB PUSH P,1 PUSH P,[FDBEPH] EPHEM1: CALL $GET1 ;GET A PROGRAM JFN, LIKE "GET" OR "RUN" ALLOW TSPC+TALT+TEOL CONFIRM MOVE 1,CJFN1 ;JFN OF THE NAMED FILE DVCHR TLNN 2,(1B4) ERROR <%1H doesn't have ephemerons> HRR 1,CJFN1 HRLI A,FDBCTL ;FDB CONTROL BITS WORD POP P,2 POP P,3 CHFDB JRST RLJFNS ;RELEASE JFN AND RETURN ; ERSTR (ERROR NUMBER) N - TYPES ERROR MESSAGE FOR N. ; .ERSTR: NOISE (error number) CALL OCTAL JRST ERSTR1 SKIPA B,A ERSTR1: MOVEI B,-1 ;USE LAST ERROR CONFIRM MOVE A,COJFN HRLI B,.FHSLF ;USE EXEC LAST ERROR SKIPL FORK ;UNLESS THERE IS A FORK HRL B,FORK ;THEN USE IT MOVEI C,0 PRINT " " ERSTR ERROR CALL SCREWUP RET ; NAME (OF USER NUMBER) N - TYPES DIRECTORY NAME. ; .XNAME: NOISE (of user number) CALL OCTAL JRST CERR CONFIRM PRINT " " MOVE B,A MOVE A,COJFN CALL $DIRST ERROR RET SRI < .CT: NOISE (^T for job # ) CALL DECIN JRST CERR JRST JCPUTL ; LET IT DO THE RETURN TO MAIN. > FEATUR %SCHED,< .SCHED: NOISE (priority word is) KEYWD $SCHED 0 JRST CERR ALLOW TALT+TEOL CONFIRM SETO A, ; POINT TO THIS JOB ONLY HRRE B,KWV ; PICK UP VALUE TO TELL SCHEDULER SKIPL B MOVSI B,(1.0) ; NORMAL VALUE IS FLOATING 1.0 JSYS 606 ; PERFORM SKUSR JSYS. RET $SCHED: TABLE TE BATCH,,,-1 TE NORMAL,,,0 TEND > ;'EXEC' - STARTS AN EXEC IN INFERIOR FORK SEPARATE FROM 'FORK' .EXEC: ALLOW TSPC+TEOL+TALT NOSCRC MFEXEC.SAV"> SCRC < HRROI B,[ASCIZ /EXEC.SAV/]> CALL TRYGTJ ;GTJFN AND SAVE IT ERROR CONFIRM JRST ERUN2 ;HANDLE AS AN EPHEMERON ;OEXEC -- RUN OLD EXEC IN THIS FORK SPACE ; REPLACES SELF WITH SPECIAL FILE .OEXEC: HRROI B,[ASCIZ /EXEC.SAV/] ; OEXEC0: CALL TRYGTJ ; ERROR MOVE B,[44B5+5B21+1B25] ;36-Bit, Read, XCT, and Thawed CALL $OPENF ;Try to open it before DIR OEXEC1: MOVE 0,CJFN1 ; FEATUR %IIT,< MOVEI A,.FHSLF ; MOVSI B,(1B14) ;TIME CHANNEL SETZ C, ;CLEAR IIT ;CLEAR IT OUT > MOVEI A,.FHSLF ; DIR ; MOVE B,PRIMRY SPJFN ;RESTORE PRIMARY JFN'S TO ENTRY VALUES MOVE 1,[OEXBLT,,OEXACS] ; BLT 1,OEXACE ;SETUP AC CODE SETO 1, ; MOVSI 2,.FHSLF ; SETZ 3, ; MOVSI 4,-1000 ; JRST OEXACS ; OEXBLT: PHASE 5 OEXACS:!HRRI 2,(4) ;UPDATE PAGE NUMBER PMAP AOBJN 4,OEXACS ; MOVSI 1,.FHSLF ; HRR 1,0 ;FORM FORK,,JFN GET ; RESET ; MOVEI 1,.FHSLF ; GEVEC ; OEXACE:!JRST 0(2) ; DEPHASE ;EXPUNGE (DELETED FILES) .EXPUN: KEYWD $EXPUN T DELETED,,EOLOK+LPROK,..EXDL JRST CERR JRST (KWV) $EXPUN: TABLE T ALL,,EOLOK+LPROK,..EXAL T DELETED,,EOLOK+LPROK,..EXDL IAC < T NON-EXISTENT,,EOLOK+LPROK,..EXNE > NOIAC < T PERMANENT,WHEEL+OPER+ENAREQ,CONMAN+EOLOK+LPROK,..EXPE > T SCRATCH,,EOLOK+LPROK,..EXSC T TEMPORARY,,EOLOK+LPROK,..EXTM TEND ..EXAL: NOISE HRLZI A,(1B12!1B13!1B15!1B16) JRST ..EXPU ..EXDL: NOISE HRLZI A,(1B12!1B13) JRST ..EXPU ..EXPE: NOISE HRLZI A,(1B14) JRST ..EXPU ..EXSC: NOISE HRLZI A,(1B15) JRST ..EXPU ..EXTM: NOISE HRLZI A,(1B16) IAC < JRST ..EXPU ..EXNE: NOISE HRLZI A,(1B12) > ..EXPU: PUSH P,A ALLOW TSPC+TALT+TEOL CONFIRM MOVEI A,0 ;Get pages used for connected dir GTDAL EXCH B,0(P) PUSH P,B GJINF POP P,A ;GET LEFT HALF BITS HRR A,B DELDF MOVEI A,0 GTDAL POP P,A SUB A,B SKIPN A TYPE < [No> SKIPLE A ETYPE < [%1Q> TYPE < page> CAIE A,1 PRINT "s" TYPE < freed] > RET ; FCONTINUE = FOREGROUND / CONTINUE .FCONTINUE: CALL .FOREGROUND CALL $CONTI JRST ..CONT ;FOREGROUND .FOREGROUND: NOISE SETO A, ;Get fork handle.. CALL GETFH ; no default MOVE B,FKFLG-.FH(A) ;Test state of fork.. TLNN B,FK%BAK ERROR TLNE B,FK%ACT ERROR CONFIRM MOVSI B,FK%BAK ;Mark fork no longer background ANDCAM B,FKFLG-.FH(A) NOINT ;While non-interruptable, CALL RLPJFN ;Return primary JFNs for fork MOVEI A,.FHSLF ; to those of MFEXEC.. GPJFN MOVE A,FORK SPJFN OKINT RET ;FORK ;SETS FORK ACCESSED BY START, REENTER, GOTO, /, \, TEN50 DDT, SAVE. .FORK: MOVEI A,.FHSLF RPCAP MOVSI A,(FH%MF) TRNE C,WHEEL+OPER IORM A,PSPRIV SETO A, ;Get fork handle.. CALL GETFH ; no default ALLOW TALT+TSPC+TEOL CONFIRM TRZ A,.FH ;MAKE FORK NUMBER FOR CIFORK MOVEM A,CIFORK RET ;GETFH - GET A HANDLE ON A FORK THAT EXISTS ; A/ fork handle default specification; ; >0 fork handle, =0 unspecified default, <0 no default ; PSPRIV/ bit FH%ALL to allow handle "*", bit FH%MF to allow handle "MF" ; CALL GETFK ; RET +1; always, ; A/ fork handle (also stored in FORK), OR ; .FHINF if * entered (FORK unchanged), OR ; 0 if unspecified default (FORK unchanged) GETFH: TLNN Z,BAKFF ;If BAKFF, input string TRNN CBT,TEOL ;If command line ended, use default.. JRST GETFH0 JUMPL A,CERR ; Command error if no default RET GETFH0: PUSH P,A PUSH P,B PUSH P,C MOVEI A,FKNMT MOVSI B,(FH%ALL) ;CHECK FOR EXTRA HELP MESSAGE TDNN B,PSPRIV TDZA B,B HRROI B,[ASCIZ / * (for all forks) /] INHELP < %1Z%%2W% Fork number> MOVE A,.BFP ILDB B,A CAIN B,"*" JRST [ MOVE A,PSPRIV TLNE A,(FH%ALL) ;OK TO SAY "ALL" CAILE CNT,2 ;YES. DID I? JRST CERR ;NO MOVEI A,.FHINF JRST GETFH3] TLO Z,BAKFF KEYWD FKNMT TE (,,NSPALT,777777) JRST GETFH1 HRREI A,(KWV) JUMPGE A,GETFH2 SKIPGE A,-2(P) ;Default allowed? JRST CERR ; no JUMPE A,GETFH3 ;Unspecified default gets quick return CAIG CNT,1 ;Solitary altmode displays fork handle CALL ALTFRK JRST GETFH2 GETFH1: CALL OCTAL CALL CERR TRZ A,.FH MOVEI B,NFKS-1 CAIL A,0 CAILE A,(B) ERROR GETFH2: MOVSI B,(FH%MF) TDNN B,PSPRIV JUMPE A,CERR TRO A,.FH PUSH P,A RFSTS TLNE A,077700 ;IS HANDLE VALID? ERROR POP P,A MOVEM A,FORK GETFH3: POP P,C POP P,B SUB P,BHC+1 RET ALTFRK: CAIE TRM,ALTM RET PUSH P,A PUSH P,B TRZ A,.FH ;Make fork index MOVE B,FKFLG(A) TLNN B,FK%NAM JRST [ $TYPE <- > JRST ALTFK1] IMULI A,SYMLTH U$TYPE FKNAM(A) $TYPE < > ALTFK1: POP P,B POP P,A RET ;GFRKNM - SUBROUTINE TO ACCEPT FORK NAME OR NUMBER WITH AN INTELLIGENT ; DEFAULT ; USED BY CONTINUE, REENTER AND START GFRKNM: SKIPGE A,FORK ;Get fork handle.. SKIPL A,LFORK ; default current fork, CAIA ; if none, default last run fork, SETZ A, ; if none, unspecified default CALL GETFH SKIPE A ;Unspecified default? RET CALL $GFRKS ;Yes, interrogate fork structure.. HRRZ B,FKSTC ;INFERIOR POINTER SKIPN B ERROR HLRZ C,0(B) ;PARALLELS SKIPE C ;ANY? RET ;YES. LEAVE FORK -1 HRRZ A,1(B) ;ONLY ONE INFERIOR, USE IT. MOVEM A,FORK RET ;MERGE COMMAND. ;GETS A FILE INTO CURRENT FORK WITHOUT RESETTING. ;PUTS BACK ENTRY VECTOR WORD THAT WAS THERE BEFORE COMMAND .MERGE: CALL $GET1 ;INPUT PROGRAM NAME ALLOW TSPC+TEOL+TALT CONFIRM ;SUBROUTINE ENTRY FOR "DDT" COMMAND. JFN IN CJFN1. $MERGE: SKIPGE A,FORK ;SKIP IF EXEC HAS INFERIOR FORK JRST $GET2 ;CREATE FORK, GET PROG, USE ITS ENTRY. GEVEC ;ALREADY HAVE A FORK PUSH P,B ;SAVE SAME CALL $GET2 ;GET PROGRAM POP P,B ;PREVIOUS ENTRY VECTOR MOVE A,FORK ;FORK HANDLE AGAIN JUMPE B,.+2 ;JUMP IF THERE WAS NO ENTRY VECTOR WD SEVEC ;SET ENTRY VECTOR TO OLD VALUE RET ;NEW and OLD only have command table entries at ISI and ECL .NEW: NOISE MOVEI A,[ASCIZ "NEWSYS"] CALL $GET12 JRST SRUN ;HANDLE AS SUBSYS .OLD: NOISE MOVEI A,[ASCIZ "OLDSYS"] CALL $GET12 JRST SRUN ;HANDLE AS SUBSYS SRUN: CAIE TRM,ALTM ;NO CONFIRM IF OTHER THAN ALTMODE TLO KWV1,PROGX MOVE A,CJFN1 ;FILE TO "RUN" DVCHR TLNE A,177777 ;ON DISK? JRST RUN1 ;NO JUST RUN IT MOVE A,CJFN1 ;GET FILE AGAIN MOVE B,[1,,FDBCTL] ;CONTROL WORD MOVEI C,C ;TO C CALL $GTFDB ;GTFDB OR DON'T SKIP JRST CERR## ;DOESN'T EXIST FOR THIS USER SCRC < TLNE C,(FDBKEP) ;AUTO KEEP? TLO Z,F2 ;YES, REMEMBER THAT >;SCRC TLNN C,(FDBEPH) ;IS THE FILE AN EPHEMERON? JRST RUN1 ALTYPE <(;E) > JRST ERUN1 ;RUN AS EPHEMERON .ERUN: NOISE (file) MOVEI A,[ASCIZ "SUBSYS"] TLO Z,F3 CALL $GET12 ;GET FILENAME AND HANDLE ERRORS CALL DIRNOI ERUN1: ALLOW TSPC+TEOL+TALT+TCOM CONFIRM ERUN2: CALL ERUN3 JRST ..STRT ERUN3: SETOM FORK ;TELL GET TO GET A NEW FORK CALL $GET2 MOVE A,FORK MOVSI B,FK%EPH IORM B,FKFLG-.FH(A) ;SAY ITS AN EPHEMERAL RET ERUNB: PUSH P,B CALL ERUN3 POP P,B JRST START1 ;SUBROUTINE TO INPUT A PROGRAM NAME. ;FIRST PART OF GET, RUN, MERGE. $GET1: NOISE (file) $GET11: SETZ A, ;SAY DEFAULT TO CONNECTED DIRECTORY $GET12: PUSH P,A ;SAVE DIRECTORY DEFAULT CALL CPFN ;INPUT PROGRAM NAME AND ASSIGN JFN JRST [ TRNE CBT,TEOL ;FAIL. JRST CERR ;AFTER CR TYPE "?" AND ABORT COMMAND. UTYPE [ASCIZ /? /] ;OTHER TERMINATORS, " ? " AND RETRY. MOVE BFP,.BFP ;BACK UP COMMAND BUFFER POINTER BTCHER ;STOP IF NON-INTERACTIVE POP P,A JRST $GET12] ;GO RETRY. POP P,A RET ;RUN COMMAND = GET + START .RUN: CALL .GET JRST ..STRT ; JOINS HERE RUN1: CALL GET1 SCRC < TLZN Z,F2 ;KEEP THIS ONE? JRST ..STRT ;NO - START IT NOW MOVE A,FORK ;YES - MARK IT TRZ A,.FH MOVSI B,FK%KPT IORB B,FKFLG(A) TYPE <[Keeping> TLNN B,FK%NAM ETYPE < as %1O> TYPE <] > >;SCRC JRST ..STRT ;GET COMMAND. ;RESETS THEN CREATES ONE FORK AND GETS PROGRAM INTO IT. ;CODED IN SUBROUTINES SO CODE CAN BE SHARED WITH "MERGE". .GET: CALL $GET1 ;INPUT PROGRAM NAME GET1: ALLOW TSPC+TEOL+TALT CONFIRM CALL $RESET ;CLOSE FILES, KILL CURRENT INF. FORK ;NOW FALL INTO $GET2, WHICH WILL RETURN ;TO COMMAND INPUT FOR "GET" BECAUSE ;DISPATCH WAS WITH "PUSHJ". ;GET... ;SUBROUTINE TO GET A PROGRAM INTO CURRENT FORK, FOR GET, RUN, AND MERGE. ;AT ENTRY CJFN1 MUST CONTAIN JFN OF FILE TO GET. $GET2: SKIPL FORK ;IS THERE A FORK? JRST GET2B ;YES (HAPPENS FOR "MERGE") CALL ECFORK ;CREATE A FORK ;Put program name in fork block and table for SETNM and commands. MOVE B,CJFN1 CALL SUBNAM GET2B: MOVE A,FORK TRZ A,.FH MOVSI B,FK%PRO ANDCAM B,FKFLG(A) ;"PROPRIETARY" BIT MAY BE SET IF ;APPROPRIATE HRRZ A,CJFN1 ;TRY TO OPEN THE FILE BEFORE THE GET MOVE B,[44B5+5B21+1B25] ; IN ORDER TO DETECT PROTECTION ERRORS CALL $OPENF HRL A,FORK GET ERJMP GETILI CALL RLJFNS ;RELEASE JFNS RET ;ILLEG INST TRAP DURING GET JSYS ;TYPE EXEC ERROR MESSAGES FOR CERTAIN ERRORS GETILI: CALL LSTERR CAIN A,GETX1 ERROR CAIN A,GETX2 ERROR JRST ILITRP## ;OTHER ERRORS TREATED IN GENERAL MANNER LSTERR::PUSH P,B MOVEI A,.FHSLF CALL $GETER## MOVE A,B POP P,B RET ;THE FOLLOWING CODE WAS PROVIDED BY SUMEX. B.E.S. MARCH 77 DIRNOI: TLNE Z,F3 ;WAS SEARCH PATH INVOKED? CAIE TRM,33 ;AND ALTMODE TERMINATED? RET ;NO, NO NAME PUSH P,A PUSH P,B PUSH P,C PUSH P,D MOVE A,CSBUFP ;PLACE TO STORE STRING MOVE B,CJFN1 ;PROGRAM JFN MOVE C,[1B5+1B35] ;DIRECTORY NAME WITH PUNCUATION JFNS MOVE C,CSBUFP ; MOVE D,[POINT 7,[ASCIZ //]] ; DIRNO1: ILDB A,C ;COMPARE THE TWO STRINGS ILDB B,D ; CAMN A,B ; JUMPN B,DIRNO1 ;KEEP GOING TO END OF STRING JUMPE B,DIRNO2 ;SUBSYS, DON'T SHOW DIR PRINT "(" ;SHOW LIKE NOISE MOVE A,CSBUFP ; CALL CTYPE ;TYPE STRING TYPE <) > ; DIRNO2: POP P,D POP P,C POP P,B POP P,A RET ;ECFORK -- Create fork TTY block. Put fork handle in FORK ; (also CIFORK if no current fork) ;Returns +1 always ;1/ Fork number ECFORK: MOVEI A,0 ;NO OPTIONS CFORK CALL [ CAIN A,CFRKX3 ERROR CAIN A,FRKHX6 ERROR JRST JERR] FFORK MOVEM A,FORK TRZ A,.FH ;MAKE FORK NUMBER SKIPGE CIFORK ;CURRENT EXIST? MOVEM A,CIFORK ;NO -- THIS WILL BE CURRENT SETZM FKSTCF ;INVALIDATE STRUCTURE IMULI A,SFKBLK ;COMPUTE OFFSET MOVSI B,FKBLK+IFKBLK ;INITIAL PROGRAM BLOCK HRRI B,FKBLK(A) BLT B,FKBLK+SFKBLK-1(A) MOVE A,FORK HRLOI B,777000 ;PRIV. TO XMIT, INC. USER SKIPE C,PRVENF ;IF ENABLED MOVE C,B ;ENABLE FORK. EPCAP TRZ A,.FH ;RETURN FORK NUMBER IN A MOVSI B,FK%BLK ;FORK BLOCK SETUP MOVEM B,FKFLG(A) ;INITIAL STATE RET ;SUBNAM ;SUBR THAT CONVERTS JFN IN B TO APPROPRIATE SUBSYSTEM NAME WORD ; FOR "SETNM" JSYS. ;TRANSPARENT, ONE USE IN "GET" CODE. SUBNAM: PUSH P,A PUSH P,B PUSH P,C PUSH P,D PUSH P,CSBUFP MOVE A,CSBUFP ;GET STRING FOR JFN IN B MOVSI C,(1B8) ;NAME ONLY JFNS ;Use this name to identify this fork in the local tables. MOVE A,CSBUFP CALL FRKNAM JFCL ;Don't worry about failure ;Convert name to sixbit for SETNM SUBN4: SETZ A, MOVE B,[POINT 6,A,-1] MOVEI D,6 SUBN4A: ILDB C,CSBUFP JUMPE C,SUBN5 ;END OF NAME, DONE TRC C,40 ;CONVERT TO SIXBIT IDPB C,B SOJG D,SUBN4A ;ALSO STOP AT 6 CHARS SUBN5: MOVE B,FORK TRZ B,.FH MOVE C,FKFLG(B) IMULI B,SFKBLK TLNE C,FK%BLK MOVEM A,FK.SNM(B) ;STORE SIXBIT NAME IN BLOCK POP P,CSBUFP POP P,D POP P,C POP P,B POP P,A RET ;GOTO .GOTO: CALL OCTAL JRST CERR ALLOW TSPC+TALT+TEOL SKIPGE FORK ;CHECK FORK HANDLE ERROR MOVE B,A CALL MAPPF ;MAP PAGE CONTAINING ADDRESS. GETS ACCESS. TLNN A,B5 ERROR TLNN A,B4 ERROR CONFIRM CALL CHKPAT ;SETUP STUFF FOR PA1050 IF LOADED ;START FORK AT ADDRESS IN B ;"DDT" JOINS HERE GOTO2: SETO A, CALL MAPPF ;UNSHARE MAPPED PAGE, IF ANY MOVE A,FORK TLNN B,1 ;DON'T START IF LH NON-0 SFORK ;START FORK (USES A AND B) CALL IFORK ;PREPARE FORK(S) AND SETUP LFORK CALL SFKTTM## TLO Z,RUNF ;SAY PROGRAM'S TELETYPE MODES ARE IN EFFECT JRST $WAIT ;WAIT FOR IT TO TERMINATE ;HERALD (CHARACTER IS) [CONFIRM] .HERALD: ALTYPE <(character is) >;;CAN'T ALLOW NOISE HERE MOVE .BFP,BFP SETZ CNT, CALL ALLBK ;ALL CHARACTERS BREAK HRLD1: CALL CCHRI ;GET A CHARACTER TLNN Z,CTRLVF ;IF NOT CONTROL-V'ED CAIE CHR,"?" ;AND IS A QUESTION MARK JRST HRLD2 ETYPE < New herald%Y>;;GIVE HELP. JRST HRLD1 HRLD2: TRNN CBT,HERCHR JRST CERR ;ILLEGAL CHARACTER PUSH P,CHR ;SAVE IT FROM CONFIRM TYPE < [Confirm]> CONFIRM POP P,A ;OK, RESTORE HERALD CHARACTER SKIPN PRVENF ;CHANGE THE CURRENT HERALD HRRM A,HERALD SKIPE PRVENF HRLM A,HERALD RET ; "BDDT" COMMAND AND "NO BDDT" COMMANDS ;F1 IS CLEARED BY MAIN DISPATCH (TO .BDDT) AND SET BY "NO" .BDDT: TLNE Z,F1 ;"NO BDDT" COMMAND? JRST .NOBD SKIPN CIFORK ;MFEXEC FORK? SETOM CIFORK ;ASSUME NO FORK SETOM A CALL MAPPF ;UNMAP ANY INFERIOR PAGE CALL CDBGFK ;CREATE DEBUGGER AND/OR USER FORKS JRST BDDT5 ;ALREADY EXISTS MOVSI B,FK%BDD ;BDDT FLAG IORM B,FKFLG(A) ;FORK NUMBER IN A MOVE A,[POINT 7,[ASCIZ "BDDT"]] CALL FRKNAM JFCL HRROI 2,[ASCIZ /BDDT.SAV/] MOVE 3,['BDDT '] CALL LDRUND ;LOAD AND RUN IT JRST $WAIT BDDT5: MOVEI A,FORK MOVSI B,FK%BDD TDNN B,FKFLG-.FH(A) JRST CERR JRST ..REEN ; "NO BDDT" COMMAND .NOBD: SKIPGE A,CIFORK RET MOVSI B,FK%BDD CALL UNSPLIC ;DO THE UNSPLICE/RESPLICE RET ; "IDDT" COMMAND AND "NO IDDT" COMMANDS ;F1 IS CLEARED BY MAIN DISPATCH (TO .IDDT) AND SET BY "NO" .IDDT: TLNE Z,F1 ;"NO IDDT" COMMAND? JRST .NOID SKIPN CIFORK ;MFEXEC FORK? SETOM CIFORK SETOM A CALL MAPPF ;UNMAP ANY INFERIOR PAGE CALL CDBGFK ;CREATE DEBUGGER AND/OR USER FORKS JRST IDDT5 ;ALREADY EXISTS MOVSI B,FK%IDD ;IDDT FLAG IORM B,FKFLG(A) ;FORK NUMBER IN A MOVE A,[POINT 7,[ASCIZ "IDDT"]] CALL FRKNAM JFCL HRROI 2,[ASCIZ /IDDT.SAV/] MOVE 3,['IDDT '] CALL LDRUND ;LOAD AND RUN IT JRST $WAIT IDDT5: MOVE A,FORK MOVSI B,FK%IDD TDNN B,FKFLG-.FH(A) JRST CERR JRST ..REEN ; "NO IDDT" COMMAND .NOID: SKIPGE A,CIFORK RET MOVSI B,FK%IDD CALL UNSPLIC ;DO THE UNSPLICE/RESPLICE RET ;ROUTINES USED BY COMMANDS WHICH RUN PROGRAMS SUCH AS IDDT, BDDT, ; TENEX LOADERS, ETC. THESE ALL OPERATE ON A "USER FORK". WHEN ; THE COMMAND IS INVOKED, THE USER IS SPLICED UNDER THE FORK ; CONTAINING THE OPERATIONAL PROGRAM ;CREATE THE DEBUGGER FORK AND/OR USER ; CREATE A USER FORK IF NECESSARY (CIFORK) ; AND A DEBUG FORK IF NECESSARY (FORK) ; SKIP RETURN IF DEBUG FORK IS NEW (NUMBER IN A) ; DEBUG FORK IS IN FORK CDBGFK: SKIPGE A,CIFORK ;IS THERE A CURRENT FORK? CALL ECFORK MOVE B,FKFLG(A) ;FORK FLAG BITS TLNE B,FK%BDD+FK%IDD RET ;FORK SHOULD CONTAIN THE DEBUGGER CALL FNDFSB ;FIND IT IN STRUCTURE PUSH P,B CALL FTPFKB ;GET AN IMMEDIATE INFER FOR IT POP P,C CAME B,C ;THE SAME? JRST [ HRRZ A,1(B) ;FORK HANDLE MOVE B,FKFLG-.FH(A) ;GET ITS FLAG BITS TLNN B,FK%BDD+FK%IDD ;A DEBUGGER? ERROR MOVEM A,FORK RET] CALL ECFORK ;CREATE A FORK FOR DEBUGGER AOS 0(P) ;SAY NEW FORK RET ;LOAD AND RUN THE DEBUGGER INTO FORK SPECIFIED BY "FORK" ;DEBUG FORK SPECIFIED BY "CIFORK" ; 2: POINTER TO ASCIZ FILE NAME (DEBUGGER) ; 3: SIXBIT NAME OF DEBUGGER (STNAM) LDRUND: PUSH P,C ;SIXBIT NAME MOVSI A,B2+B17 GTJFN JRST [ MOVE A,FORK CALL $KFORK JRST CERR] HRL A,FORK ;FORK FOR DEBUGGER GET ERJMP [MOVE A,FORK CALL $KFORK JRST GETILI] MOVE A,FORK GEVEC HLRZS B CAIGE B,10 ;GENERAL SUSPICION CAIGE B,3 JRST [ MOVE A,FORK CALL $KFORK ERROR (Bad entry vector)] NOINT MOVE A,FORK MOVE B,CIFORK ;THIS IS WHAT NEEDS DEBUGGING TRO B,.FH ;MAKE SURE IT'S A HANDLE SPLFK CALL [ PUSH P,A MOVE A,FORK CALL $KFORK POP P,A JRST JERR] SETZM FKSTCF ;SAY STORED STRUCTURE BAD MOVEM A,PAGEN+1 ;HANDLE FOR DEBUGGER TO KNOW FORK BY MOVE A,FORK ;HANDLE TO KNOW DEBUGGER BY TRZ A,.FH IMULI A,SFKBLK POP P,FK.SNM(A) ;NAME TO SETNM MOVE A,FORK MOVEI B,PAGEN SFACS OKINT MOVE A,FORK MOVEI B,2 SFRKV ERJMP SFVILI CALL IFORK CALL SFKTTM## TLO Z,RUNF RET ;UNSPLICE ; FOLLOW THE STRUCTURE TO FIND A DEBUGGER ; AND KILL IT ;A/ FORK HANDLE OR NUMBER ;B/ MASK OF "DEBUGGER TYPE" BITS UNSPLICE: PUSH P,B CALL FNDFSB UNSPL1: HRRZ A,1(B) ;HANDLE JUMPE A,UNSPL2 ;NO HANDLE, FORGET IT MOVE C,FKFLG-.FH(A) ;FLAGS TDNE C,0(P) ;THIS THE ONE TO KILL? JRST UNSPL3 ;YES. UNSPL2: HLRZ B,1(B) ;SUPERIOR CAIE B,FKSTC ;TOP JRST UNSPL1 ;NOT YET SUB P,[XWD 1,1] RET ;NO DEBUGGER TO KILL! UNSPL3: SUB P,[XWD 1,1] CALL UNSPFK ;SPLICE UP ALL INFERIORS JRST $KFORK ;UNSPFK -- UNSPLICE THE FORKS BELOW SPECIFIED FORKS ;A/ HANDLE OF FORK TO HAVE ITS INFERIORS REMOVED UNSPFK: NOINT CALL FNDFSB HLRZ B,1(C) ;SUPERIOR HRRZ A,1(B) ;HANDLE HRRZ B,0(C) ;INFERIOR UNSPF1: PUSH P,B HRRZ B,1(B) ;HANDLE SETZM FKSTCF ;INVALIDATE STRUCTURE SPLFK CALL JERR POP P,B HLRZ B,0(B) ;PARALLEL JUMPN B,UNSPF1 OKINT HRRZ A,1(C) ;ORIGINAL HANDLE RET ;INTERROGATE (THE ARCHIVE) ;NOTE: THE INTERROGATE PROGRAM EATS THE REST OF THE COMMAND LINE. .INTER: ALLOW TSPC+TALT HRROI B,[ASCIZ "ARCHIVE-LOOKUP.SAV"] CALL TRYGTJ ERROR TLO KWV1,PROGX ;SAY CONFIRMATION TO BE DONE BY LOOKUP JRST ERUN2 ;GO HANDLE AS AN EPHEMERON SCRC < ;FINGER (USER) EATS ITS COMMAND LINE .FINGE: ALLOW TSPC+TALT+TEOL HRROI B,[ASCIZ /FINGER.SAV/] CALL TRYGTJ ERROR (No FINGER program) TLO KWV1,PROGX ;SAY CONFIRMATION TO BE DONE BY LOOKUP JRST ERUN2 ;GO HANDLE AS AN EPHEMERON > ;JFNCLOSE .JFNCL: CALL OCTAL JRST CERR ALLOW TSPC+TALT+TEOL CAIG A,MAXJFN CAIGE A,0 JRST CERR GTSTS TLNN B,B10 JRST CERR ;INVALID OR UNASSIGNED JFN CONFIRM MOVE B,JBUFP PUSH B,A ;PUT JFN IN STACK WHERE RLJFNS LOOKS MOVEM B,JBUFP JRST RLJFNS ;CLOSE IF OPEN, AND RELEASE JFN. ;KEEP (FORK AS) NAME .KEEP: SKIPG A,CIFORK ERROR CALL FNDFSB HRRZ A,1(C) ;HANDLE MOVE B,FKFLG-.FH(A) TLNE B,FK%BDD+FK%IDD ERROR HLRZ B,1(C) ;SUPERIOR CAIN B,FKSTC ;MFEXEC (IMMEDIATE INFERIOR) JRST KEEP1 HRRZ A,1(B) ;HANDLE CAIE A,0 MOVE A,FKFLG-.FH(A) ;BITS TLNN A,FK%BDD+FK%IDD ERROR KEEP1: TRNE CBT,TEOL ;KEEP JRST KEEP4 NOISE INHELP ALLOW TALT+TSPC+TEOL CAILE CNT,^D20 ERROR MOVE A,.BFP ;STRING POINTER HRREI B,-1(CNT) JUMPLE B,KEEP4 CALL BUFFF CALL KCKOCT ;Check for octal name ERROR ALTYPE ( ) CONFIRM CALL FRKNAM ;MAKE A NAME FOR "FORK" ERROR ;Only error left KEEP3: MOVE A,CIFORK MOVEI B,(A) IMULI B,SYMLTH HRROI C,FKNAM(B) TLZE Z,F1 ETYPE < Kept as %3W% > MOVSI B,FK%KPT IORM B,FKFLG(A) RET KEEP4: MOVE A,CIFORK MOVE B,FKFLG(A) TLNN B,FK%NAM JRST KEEP5 IMULI A,SYMLTH UALTYP FKNAM(A) ALTYPE ( ) TRNE CBT,TEOL TLO Z,F1 ;SAY TYPE NAME CONFIRM JRST KEEP3 KEEP5: ;KEPT AS NUMBER ALTYPE (- ) CONFIRM MOVE A,CIFORK MOVSI B,FK%KPT IORM B,FKFLG(A) ETYPE < Kept as Fork %1O > RET KCKOCT: PUSH P,A ;Byte pointer PUSH P,B KCKOC1: ILDB B,A ;Get a character JUMPE B,KCKOC2 ;Possible conflict MOVE B,CHRTBL(B) ;Class TRNE B,OCTDIG ;Test for octal digit JRST KCKOC1 ;Check all characters of field JRST KCKOC3 ;No conflict KCKOC2: PUSH P,C MOVE A,-2(P) MOVEI C,^D8 NIN MOVEI B,377777 ;Assume no conflict POP P,C TRZ B,.FH CAIL B,0 ;Check range of fork handles CAILE B,NFKS-1 KCKOC3: AOS -2(P) ;No conflict, skip return POP P,B POP P,A RET ;FRKNAM - Set fork name ; A/ Pointer to ASCIZ string ; CALL FRKNAM ; RET +1; Name in use or conflicts with number FRKNAM: CALL KCKOCT ;Does name conflict with number RET ;Yes. Fail return. PUSH P,A PUSH P,B PUSH P,C PUSH P,D SETZM CWBUF SETZM CWBUF+1 SETZM CWBUF+2 SETZM CWBUF+3 MOVEI B,SYMLTH*5-1 MOVE D,[POINT 7,CWBUF] FKNAM1: ILDB C,A CAIL C,141 ;LOWER CASE A CAILE C,172 ;LOWER CASE Z JRST .+2 SUBI C,40 IDPB C,D SKIPE C SOJG B,FKNAM1 MOVEI A,FKNMT MOVEI B,CWBUF SETOM NOCKPV CALL FSYM JFCL ;NO MATCH AT ALL -- GO AHEAD JFCL ;AMBIGUOUS -- DO THE SAME JRST FKNAM3 ;PARTIAL -- SAME SETZM NOCKPV HRRZ C,(C) ;GET FORK NUMBER TRO C,.FH ;MAKE FORK HANDLE CAMN C,FORK ;EXACT MATCH, SEE IF IT'S THE RIGHT FORK FKNAM2: AOS -4(P) ;SKIP RETURN POP P,D POP P,C POP P,B POP P,A RET FKNAM3: SETZM NOCKPV NOINT ;DON'T ALLOW ^C DURING THIS MOVE A,FORK TRZ A,.FH ;FORK NUMBER CALL KFNAME MOVEI A,FKNMT MOVEI B,CWBUF CALL FSYM ;POINTER MAY TO CHANGE (DELETED ENTRY) JFCL JFCL JRST .+2 CALL SCREWUP ;EXACT MATCH IMPOSSIBLE, ANTHING ELSE OK MOVE A,FORK TRZ A,.FH ;FORK NUMBER AGAIN MOVSI C,FK%NAM IORM C,FKFLG(A) MOVE C,A IMULI A,SYMLTH MOVEI A,FKNAM(A) HRLI A,FKNNB##(C) MOVEI C,(A) HRLI C,CWBUF BLT C,3(A) EXCH A,(B) CAIGE B,FKNMT+NFKS ;END OF TABLE, STOP AOJA B,.-2 AOS FKNMT ;BUMP TABLE LENGTH OKINT JRST FKNAM2 ;LABEL (of device) DTAn: (is) .LABEL: NOISE CALL DEVN PUSH P,A ;START OUT AS IN ASSIGN PUSH P,B LDB B,[POINT 9,A,17] CAIE B,3 ;DTA? ERROR MOVE B,0(P) TLNN B,B5 ;AVAILABLE? JRST [ TLNN B,B6 ;NO, SAY WHY UERR [ASCIZ/%1H: not available/] UERR [ASCIZ/%1H: already assigned to Job %3Q/]] TLO A,(1B3) ;MOUNT IN NON-DIR MODE MOUNT CALL JERR ;CAN'T ,SAY WHY MOVE B,A ;DONE NOW GENERATE A JFN TLZ B,(1B3) ;REAL DESIG HRROI A,1(P) ;STUFF NAME ONTO STACK DEVST CALL [ EXCH A,B ;PUT REASON IN CORRECT PLACE JRST JERR] MOVEI B,":" ;COMPLETE THE NAME IDPB B,A SETZ B,B IDPB B,A MOVSI A,(1B17) HRROI B,1(P) GTJFN CALL JERR MOVE B,JBUFP ;STACK QUICKLY SO RLJFNS CAN RELEASE PUSH B,A MOVEM B,JBUFP MOVE B,[17B9+3B20] ;OPEN R/W DUMP MODE OPENF CALL JERR MOVEI B,30 ;FOCUS ON THE DIR BLOCK MOVEI C,^D100 MTOPR MOVEI B,[IOWD 200,BUF1 0] DUMPI ;GET THE WHOLE BLOCK JRST LABL1 MOVEI B,30 ;REFOCUS ON DIR BLOCK MOVEI C,^D100 MTOPR SETZ A,A TRNE CBT,TEOL ;EOL MEANS NO LABEL JRST LABL2 NOISE CALL SIXIN ;RETURN WITH RESULT IN 'A' LABL2: MOVEM A,BUF1+177 ;LABEL WORD IN DIR BLOCK CONFIRM MOVE A,JBUFP MOVE A,0(1) MOVEI B,[IOWD 200,BUF1 0] DUMPO ERROR LABL3: CALL RLJFNS POP P,B POP P,A DSMNT CALL JERR TLNN B,B8 ;PREVIOUSLY MOUNTED? RET MOUNT ;YES, MOUNT NORMAL CALL JERR RET LABL1: TYPE JRST LABL3 SIXIN: TLO Z,PUNCF CALL CSTR CAIG CNT,1 JRST [ TLO Z,BAKFF ;RETURN NULL SETZ A,A RET] CALL BUFFF ;STUFF IN BUFFER MOVE B,A CAIN TRM,ALTM CALL UBP SETZ A,A MOVE C,[POINT 6,A] SIXI1: ILDB D,B JUMPE D,SIXI2 CAIGE D,40 MOVEI D,40 ;FLUSH CONTROL CHARS CAIGE D,140 ;LOWER CASE? ADDI D,40 ;YES, CONVERT IDPB D,C TRNN C,777776 ;IS B CLOBBERED? JRST SIXI1 ;NO, MORE TO GET SIXI2: RET ;LINK (TERMINAL/USER) .LINK: NOISE (to) CALL TTYNUM ;GET LINE NUMBER, MAYBE FROM USER NAME MOVEI B,400000(A) ;FORM TTY DESIGNATOR SKIPG CUSRNO ;Are we logged in? CALL LINK1 ;No, check for system CTY HRLOI A,(1B2!1B3) ;TO AND FROM CONTROLLING TTY TLINK ERROR RET LINK1: PUSH P,A PUSH P,B MOVE A,['LOGDES'] SYSGT JUMPE B,LINK1A ;No table, allow link MOVE A,B HRLI A,1 GETAB CALL JERR CAME A,0(P) ;Requested CTY CAIN A,377777 ; or no CTY JRST LINK1A TRZ A,1B18 ERROR LINK1A: POP P,B POP P,A RET ;"LIST" IS WITH "TYPE" BELOW. ;LOG COMMAND ; ALLOWS LOG TO DEFAULT TO LOGIN IF NOT LOGGED IN BUT GIVES A ; QUESTION MARK IF ALREADY LOGGED IN (INSTEAD OF LONG MESSAGE.) .LOG: SKIPLE CUSRNO JRST CERR ALTYPE (IN ) ;LOGIN COMMAND ;LOGIN (USER) (PASSWORD) (ACCOUNT [#]) <#> .LOGIN: SKIPLE CUSRNO ERROR TLZE Z,F1 JRST LOGIN1 ;SKIP THE CRUD IF SPECIAL LOGIN TYPE CALL LGNCHK ;TYPE MSG IF LOGINS ARE PROHIBITTED JUMPE A,LOGIN0 ;NOTHING WAS TYPED, PROCEDE TYPE < You may "ATTACH" to an existing job> ;PROVIDE ADDITIONAL INFO RET ;DECODE ARGUMENTS ;TWO GENERAL FORMS ACCEPTED: ARGS ON SAME LINE, TERMINATED WITH ;SPACE OR ALT MODE, AND ARGS ON SEPARATE LINES, TERMINATED WITH EOL. ;SECOND FORM IS INCONSISTENT WITH REST OF EXEC LANGUAGE BUT WAS ADDED ;BECAUSE IT MAKES HDX LOGIN CLEANER: ON HALF DUPLEX TTY, PASSWORD ;IS INPUT ON A SEPARATE LINE WHERE A MASK HAS BEEN TYPED. ;SPECIAL HANDLING OF EOL AS A TERMINATOR IS DONE BY THE "SPECEOL" SUBR ;WHICH IMMEDIATELY FOLLOWS "LOGIN" IN THIS LISTING. LOGIN0: CALL SPECEOL ;HANDLE TERMINATOR FOR THE WORD "LOGIN" ;FIRST ARGUMENT: USER NAME NOISE ; ;SEE COMMENTS ON "SPECEOL" ABOUT "NOISE" LOGIN1: CALL USERN ;INPUT USER NAME, XLATE TO USER # IN A ;USE "DIRNAM" IF RECOGNITION DESIRED PUSH P,A ;SAVE INFO RETURNED BY "STDIR" TLNE A,B0 ERROR IAC < MOVEI 1,1 HRROI 2,[ASCIZ /ANONYMOUS/] STDIR JFCL JRST .+5 HRRZ 2,1 HRRZ 1,(P) CAMN 1,2 ERROR MOVE A,(P) ; GET BACK LOGIN ARG > SCRC < TRNE CBT,TEOL ;ALLOW NOT GIVING A PASSWORD JRST [ HRRZ A,(P) ;GET USER NUMBER TLO A,400000 ;JUST CHECK PASSWORD HRROI B,[ASCIZ //] CNDIR JRST .+1 ;LOOKS LIKE WE NEED A PASSWORD HRROI A,[ASCIZ //] JRST .+4]> CALL SPECEOL ;HANDLE TERMINATOR OF "USER" FIELD ;2ND ARGUMENT: PASSWORD HRRZ A,(P) ;USER # CALL PASWD ;INPUT PASSWORD, RETURN POINTER IN A. PUSH P,A ;SAVE PTR FOR USE IN "LOGIN" JSYS CALL ;3RD ARGUMENT: ACCOUNT NUMBER MOVE A,-1(P) ;WHAT STDIR RETURNED:B1 SAYS STRING ACCT SCRC < TRNE CBT,TEOL ;ENDED WITH NEWLINE? JRST [ CALL DEFACT CAMN A,MINUS1 JRST .+1 JRST .+6] > TLNN A,B1 NOISE ; IF USER REQUIRES NUMERIC ACCOUNT TLNE A,B1 NOISE ; IF USER REQUIRES STRING CALL ACCT ;INPUT AND DECODE ACCT # (USES A) PUSH P,A ;SAVE FOR LOGIN JSYS PUSH P,B ;SAVE PIE SLICE CONFIRM ;CONFIRM THE WHOLE COMMAND ;LOGIN... ;ALL ARGS DECODED, NOW LOG THE GUY IN POP P,D ;PIE SLICE POP P,C ;ACCT # OR PTR THERETO POP P,B ;PASSWORD PTR HRRZ A,(P) ;USER # LOGIN CALL [ CAIN A,LGINX1 ;CHECK FOR A FEW ERRORS NOT CHECKED B4. UERR [ASCIZ /Illegal account/] JRST JERR] ;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC). MOVE B,(P) ;WHAT "STDIR" RETURNED HRRZM B,CUSRNO ;STORE USER NUMBER PUSH P,A ;SAVE DATE & TIME OF LAST LOGIN ;KILL AUTOLOGOUT FORK WHICH WATCHES FOR ABANDONED JOB SKIPG ALOFH ;AUTOLOGOUT FORK HANDLE, OR 0 OR -1 JRST LOGIN6 ;NO AUTOLOGOUT FORK - EG STARTUP FAILED MOVE A,ALOFH CAIE A,400000 ;IIT SYSTEM? KFORK ;KILL THE FORK SETOM ALOFH ;SAY THE ALO FORK HAS BEEN KILLED LOGIN6: SETOM LOGINI ;REQUEST LOGIN.CMD TO BE PROCESSED SETZM OLDDTM ;CLEAR DOWNTIME FLAG SETZM ITIMER ;DO PERIODIC CHECKS ;... ;LOGIN... ;UPDATE SPECIAL CAPABILITIES ;... MOVEI A,B0 RPCAP HLLZ C,B SKIPE PRVENF HRR C,B EPCAP ;TYPE "JOB ON LINE N